Страницы: 1
RSS
Макрос для копирования части содержимого ячейки
 
Всем привет! Не могу понять как должен выглядеть код макроса, который бы копировал из ячейки определенные данные и вставлял их в пустую ячейку.
Например,  столбец выглядит следующим образом.

Код
Пластина 720х8,5-К56, АКПП тип 1  
Пластина 543х9,5-К52, АКПП тип 1
Пластина 364х7,0-К54, АКПП тип 1
Пластина 1080х4,3-К57, АКПП тип 1
Пластина 436х7,0-К56, АКПП тип 1

и далее около 100 подобных ячеек

Нужно, чтобы в числа 720, 543, 364, 1080, 436 записались в один столбец, числа 8,5; 9,5; 7,0; 4,3; 7,0 в другой, а К56, К52,К54.... в третий столбец. Подскажите, пожалуйста, как может выглядеть код.

Изменено: kudim - 20.02.2017 11:20:44
 
А формулами нельзя? Именно макрос нужен?
 
_Igor_61, Хотелось бы макросом, т.к. таких табличек много. Но если вы можете подсказать формулу, тоже буду рад!
 
Данные в столбце А
Код
Sub Raznesti()
Dim i As Long
Dim iTemp As String
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To iLastRow
    iTemp = Split(Split(Cells(i, 1), " ", 2)(1), " ")(0)
    Cells(i, 2) = Split(iTemp, "х")(0)
    iTemp = Split(iTemp, "х")(1)
    Cells(i, 3) = CDbl(Split(iTemp, "-")(0))
    Cells(i, 4) = Left(Split(iTemp, "-")(1), Len(Split(iTemp, "-")(1)) - 1)
  Next
End Sub
 
Формулами:
 
Спасибо всем большое!
 
добрый день,еще вариант макроса со считыванием в массив,кнопки test и очистка.
Код
Sub test()
     Dim z, z1, t$, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
     ReDim z1(1 To UBound(z), 1 To 3)
  With CreateObject("VBScript.RegExp")
    For i = 1 To UBound(z): t = z(i, 1)
  .Pattern = "\d+":   z1(i, 1) = .Execute(t)(0)
  .Pattern = "\d+,\d+": z1(i, 2) = .Execute(t)(0)
  .Pattern = "[А-ЯЁ]+\d+": z1(i, 3) = .Execute(t)(0)
   Next
   Range("B1").Resize(UBound(z1), 3).Value = z1
   End With
End Sub
Изменено: sv2013 - 20.02.2017 13:51:23
 
sv2013, Спасибо!
Страницы: 1
Наверх