как разнести два столбца ? в первом ключевое слово (число), во втором набор ключевых слов (чисел) разделенных запятыми или пробелами. Нужно привести к двум столбцам содержащих в первой строке ключевое слово первого столбца и первое ключевое слово из второго столбца, во второй строке ключевое слово из первого столбца первой строки и второе ключевое слово из второго столбца первой строки и т.д.
как разнести два столбца ? в первом ключевое слово (число), во втором набор ключевых слов (чисел) разделенных запятыми или пробелами. Нужно привести к двум столбцам содержащих в первой строке ключевое слово первого столбца и первое ключевое слово из второго столбца, во второй строке ключевое слово из первого столбца первой строки и второе ключевое слово из второго столбца первой строки и т.д. mr_maxim
Sub ertert() Dim x, y(), i&, j&, k&, sp With Range("A1").CurrentRegion x = .Value ReDim y(1 To 2, 1 To UBound(x)) For i = 1 To UBound(x) sp = Split(x(i, 2), ",") For j = 0 To UBound(sp) k = k + 1: If k > UBound(y, 2) Then ReDim Preserve y(1 To 2, 1 To UBound(y, 2) * 2) y(1, k) = x(i, 1): y(2, k) = sp(j) Next j Next i .Resize(k).Value = Application.Transpose(y()) End With End Sub
[/vba]
например, так: [vba]
Код
Sub ertert() Dim x, y(), i&, j&, k&, sp With Range("A1").CurrentRegion x = .Value ReDim y(1 To 2, 1 To UBound(x)) For i = 1 To UBound(x) sp = Split(x(i, 2), ",") For j = 0 To UBound(sp) k = k + 1: If k > UBound(y, 2) Then ReDim Preserve y(1 To 2, 1 To UBound(y, 2) * 2) y(1, k) = x(i, 1): y(2, k) = sp(j) Next j Next i .Resize(k).Value = Application.Transpose(y()) End With End Sub