2015-05-08 3 views
1

У меня есть таблица Excel, которая имеет один столбец, который может иметь множество значений, разделенных запятой, например значением1; value2; value3. Мне нужно сделать, чтобы дублировать всю строку для каждого значения, причем каждая строка имеет только одно из значений.Разделить содержимое поля и повторяющейся строки

Пример:

value1;value2;value3,abc,100 
value4;value5,xyz,200 
value6,def,300 

должен в конечном итоге, как это:

value1,abc,100 
value2,abc,100 
value3,abc,100 
value4,xyz,200 
value5,xyz,200 
value6,def,300 
+1

Посмотрите на функцию [Split Function] VBA (https://msdn.microsoft.com/e n-us/library/6x627e5f% 28v = vs.90% 29.aspx) и вариантные массивы. – Jeeped

+1

Сначала разделите на ',' с лимитом '2'. Затем разделите 0-й элемент в этом массиве на ';' без ограничений. Итерируйте эти результаты и присоедините их к 1-му элементу из первого разделения. Затем вы можете добавлять строки, если в этой итерации содержится более одного элемента. –

ответ

1

Вы можете использовать ниже код для разделения и записи данных на другом листе ...

Лист 1 содержит вход и лист 2 содержат данные по вашему запросу ...

Dim i As Integer 
Dim j As Integer 
Dim k As Integer 
Dim x As Integer 
Dim y As Integer 

i = 1 'Row 
j = 1 'Col 

'Destination Row & Col 
x = 1 
y = 1 

While (Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, j).Value) <> "") 
    Dim CellValue1 As String 
    Dim CellValue2 As String 
    Dim CellValue3 As String 
    Dim ValArray() As String 
    Dim arrayLength As Integer 

    CellValue1 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, j).Value) 
    CellValue2 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, (j + 1)).Value) 
    CellValue3 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, (j + 2)).Value) 
    ValArray = Split(CellValue1, ";") 
    arrayLength = UBound(ValArray, 1) - LBound(ValArray, 1) + 1 

    k = 0 
    While (k < arrayLength) 
     'MsgBox ((ValArray(k) & CellValue2 & CellValue3)) 
     ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = ValArray(k) 
     y = y + 1 
     ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = CellValue2 
     y = y + 1 
     ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = CellValue3 
     x = x + 1 
     y = 1 
     k = k + 1 
    Wend 
    i = i + 1 
Wend 
3

с данными в столбце этот макрос:

Sub Byron() 
    Dim r As Range, K As Long, v As String 
    K = 1 
    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange) 
     v = r.Value 
     p1 = Mid(v, 1, InStr(1, v, ",") - 1) 
     p2 = Mid(v, InStr(1, v, ",")) 
     ary = Split(p1, ";") 
     For Each a In ary 
      Cells(K, 2).Value = a & p2 
      K = K + 1 
     Next a 
    Next r 
End Sub 

поместит результаты в колонке B:

enter image description here

(это просто перевод комментария Байрона в VBA)

Смежные вопросы