Вроде задача не сложная, но нигде не могу найти решение.. Подскажите, пожалуйста.. Есть три столбца, в которых N-е кол-во строк со словами. Например 1я колонка - БРЕНД: Вискас, Китекэт, Колгейт, Тайд, Ариель. 2я колонка - МАГАЗИН: Ашан, Лента, Пятерочка. 3я колонка - СТАТУС: В заказе, На полке, В пути итп. Макрос, который бы склеивал все слова со всеми во всех колонках, с пробелом. Например: Вискас Ашан в заказе Вискас Ашан на полке ...... Китекэт Лента в Заказе итп
каждое слово должно быть склеено с каждым из соседних колонок, по очереди, и это все в один столбец. Данных может быть разное кол-во, поэтому нужно, чтобы макрос определял последнюю заполненную ячейку в каждом столбце. Помогите, пожалуйста...
Вроде задача не сложная, но нигде не могу найти решение.. Подскажите, пожалуйста.. Есть три столбца, в которых N-е кол-во строк со словами. Например 1я колонка - БРЕНД: Вискас, Китекэт, Колгейт, Тайд, Ариель. 2я колонка - МАГАЗИН: Ашан, Лента, Пятерочка. 3я колонка - СТАТУС: В заказе, На полке, В пути итп. Макрос, который бы склеивал все слова со всеми во всех колонках, с пробелом. Например: Вискас Ашан в заказе Вискас Ашан на полке ...... Китекэт Лента в Заказе итп
каждое слово должно быть склеено с каждым из соседних колонок, по очереди, и это все в один столбец. Данных может быть разное кол-во, поэтому нужно, чтобы макрос определял последнюю заполненную ячейку в каждом столбце. Помогите, пожалуйста...resettt
скрипт делает не совсем как у вас,но может подойдет,чтобы не усложнять на листе не должно быть скрытых строк [vba]
Код
Sub Macro1()
Dim a(), b(), c(), res() Dim lngLastRow1 As Long, lngLastRow2 As Long, lngLastRow3 As Long, lngLastRow4 As Long Dim i As Long, j As Long, k As Long, r As Long
ReDim res(1 To (lngLastRow1 - 1) * (lngLastRow2 - 1) * (lngLastRow3 - 1), 1 To 1)
For i = 2 To lngLastRow1 For j = 2 To lngLastRow2 For k = 2 To lngLastRow3 r = r + 1 res(r, 1) = a(i, 1) & " " & b(j, 1) & " " & c(k, 1) Next k Next j Next
Range("D2").Resize(UBound(res), 1).Value = res
End Sub
[/vba]
скрипт делает не совсем как у вас,но может подойдет,чтобы не усложнять на листе не должно быть скрытых строк [vba]
Код
Sub Macro1()
Dim a(), b(), c(), res() Dim lngLastRow1 As Long, lngLastRow2 As Long, lngLastRow3 As Long, lngLastRow4 As Long Dim i As Long, j As Long, k As Long, r As Long
ReDim res(1 To (lngLastRow1 - 1) * (lngLastRow2 - 1) * (lngLastRow3 - 1), 1 To 1)
For i = 2 To lngLastRow1 For j = 2 To lngLastRow2 For k = 2 To lngLastRow3 r = r + 1 res(r, 1) = a(i, 1) & " " & b(j, 1) & " " & c(k, 1) Next k Next j Next
Sub ikki() Dim b$(), n1&, n2&, n3&, i&, j&, k&, n& With Sheets("Лист1") n1 = .Cells(.Rows.Count, 1).End(xlUp).Row n2 = .Cells(.Rows.Count, 2).End(xlUp).Row n3 = .Cells(.Rows.Count, 3).End(xlUp).Row ReDim b(1 To (n1 - 1) * (n2 - 1) * (n3 - 1), 1 To 1) For i = 2 To n1 For j = 2 To n2 For k = 2 To n3 n = n + 1 b(n, 1) = .Cells(i, 1) & " " & .Cells(j, 2) & " " & .Cells(k, 3) Next k, j, i .[d2].Resize(UBound(b)).Value = b End With End Sub
[/vba] Решение просто супер.
Всем спасибо
На другом форуме подсказали:
[vba]
Код
Sub ikki() Dim b$(), n1&, n2&, n3&, i&, j&, k&, n& With Sheets("Лист1") n1 = .Cells(.Rows.Count, 1).End(xlUp).Row n2 = .Cells(.Rows.Count, 2).End(xlUp).Row n3 = .Cells(.Rows.Count, 3).End(xlUp).Row ReDim b(1 To (n1 - 1) * (n2 - 1) * (n3 - 1), 1 To 1) For i = 2 To n1 For j = 2 To n2 For k = 2 To n3 n = n + 1 b(n, 1) = .Cells(i, 1) & " " & .Cells(j, 2) & " " & .Cells(k, 3) Next k, j, i .[d2].Resize(UBound(b)).Value = b End With End Sub
А в чем разница? Имена переменных другие! А вот код нужно оформить тегом, как у Karataev-а. Значек #. ЗЫ. Еще короче [vba]
Код
Sub qqq() Dim i&, j&, k&, r&: r = 2 For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To Cells(Rows.Count, 2).End(xlUp).Row For k = 2 To Cells(Rows.Count, 3).End(xlUp).Row Cells(r, 4) = Cells(i, 1) & " " & Cells(j, 2) & " " & Cells(k, 3): r = r + 1 Next k, j, i End Sub
А в чем разница? Имена переменных другие! А вот код нужно оформить тегом, как у Karataev-а. Значек #. ЗЫ. Еще короче [vba]
Код
Sub qqq() Dim i&, j&, k&, r&: r = 2 For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To Cells(Rows.Count, 2).End(xlUp).Row For k = 2 To Cells(Rows.Count, 3).End(xlUp).Row Cells(r, 4) = Cells(i, 1) & " " & Cells(j, 2) & " " & Cells(k, 3): r = r + 1 Next k, j, i End Sub