Привет всем, давно уже не прикасался к таблицам, но пришла мысль, что именно в них можно найти решение проблемы. У меня есть два столбца по 15 строк в каждом (слова) и мне нужно собрать словосочетания из них и выдать их результаты в определенный столбец построчно. Как это сделать я примерно понимаю, но не знаю как это написать в VBA. может кто поможет, подскажет решение? Спасибо огромное!
Привет всем, давно уже не прикасался к таблицам, но пришла мысль, что именно в них можно найти решение проблемы. У меня есть два столбца по 15 строк в каждом (слова) и мне нужно собрать словосочетания из них и выдать их результаты в определенный столбец построчно. Как это сделать я примерно понимаю, но не знаю как это написать в VBA. может кто поможет, подскажет решение? Спасибо огромное!panfilov
Вот пример. И вот нужно в столбец результатов построчно выдать все возможные словосочетания из данных столбцов и строк где указаны Имя, Действие и Место
Вот пример. И вот нужно в столбец результатов построчно выдать все возможные словосочетания из данных столбцов и строк где указаны Имя, Действие и Местоpanfilov
panfilov, почему сразу не написали нужное количество столбцов? Поправила код. Переменная m отвечает за количество столбцов [vba]
Код
Sub www() Dim i&, j&, n&, data data = Range("A2", Range("f2").End(xlDown)).Value n = UBound(data) m = 6 ReDim out(1 To n ^ m, 1 To 1)
For i = 1 To n ^ m For j = 1 To m out(i, 1) = out(i, 1) & IIf(j = 1, "", " ") & data(i \ n ^ (m - j) Mod n + 1, j) Next j, i Range("h2", Range("h2").End(xlDown)).ClearContents Range("h2").Resize(n ^ m, 1) = out End Sub
[/vba]
panfilov, почему сразу не написали нужное количество столбцов? Поправила код. Переменная m отвечает за количество столбцов [vba]
Код
Sub www() Dim i&, j&, n&, data data = Range("A2", Range("f2").End(xlDown)).Value n = UBound(data) m = 6 ReDim out(1 To n ^ m, 1 To 1)
For i = 1 To n ^ m For j = 1 To m out(i, 1) = out(i, 1) & IIf(j = 1, "", " ") & data(i \ n ^ (m - j) Mod n + 1, j) Next j, i Range("h2", Range("h2").End(xlDown)).ClearContents Range("h2").Resize(n ^ m, 1) = out End Sub
Чисто приколу для и упражнения ради — с формулами и произвольным числом столбцов: [vba]
Код
Sub tt()
Dim Прав, Рез, Ниж As Integer Dim Формула As String
Прав = Rows(1).Find(what:="", LookAt:=xlWhole).Column - 1 Ниж = Cells(Rows.Count, 1).End(xlUp).Row Рез = Range(Cells(1, Прав + 2), Cells(1, Columns.Count)).Find(what:="", LookAt:=xlWhole).Column If Рез = Прав + 2 Then Cells(1, Рез).Value = "Результат" Формула = "=" For i = 1 To Прав Формула = Формула & "RC[-" & Прав + 2 - i & "]&"" ""&" Next i Формула = Left(Формула, Len(Формула) - 1) With Range(Cells(2, Прав + 2), Cells(Ниж, Прав + 2)) .FormulaR1C1 = Формула .Copy .PasteSpecial xlPasteValues End With
End Sub
[/vba] Любопытно было бы сотворить то же самое для таблицы, про которую только известно, что она где-то на листе
Чисто приколу для и упражнения ради — с формулами и произвольным числом столбцов: [vba]
Код
Sub tt()
Dim Прав, Рез, Ниж As Integer Dim Формула As String
Прав = Rows(1).Find(what:="", LookAt:=xlWhole).Column - 1 Ниж = Cells(Rows.Count, 1).End(xlUp).Row Рез = Range(Cells(1, Прав + 2), Cells(1, Columns.Count)).Find(what:="", LookAt:=xlWhole).Column If Рез = Прав + 2 Then Cells(1, Рез).Value = "Результат" Формула = "=" For i = 1 To Прав Формула = Формула & "RC[-" & Прав + 2 - i & "]&"" ""&" Next i Формула = Left(Формула, Len(Формула) - 1) With Range(Cells(2, Прав + 2), Cells(Ниж, Прав + 2)) .FormulaR1C1 = Формула .Copy .PasteSpecial xlPasteValues End With
End Sub
[/vba] Любопытно было бы сотворить то же самое для таблицы, про которую только известно, что она где-то на листе StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.