Смещение VBA в цикле - PullRequest
Новая
       24

Смещение VBA в цикле

0 голосов
/ 25 апреля 2018

У меня проблемы с объединением функции смещения VBA в цикле. По сути, я пытаюсь извлечь несколько наборов значений из столбца данных на основе поискового запроса (survey значение). Я могу заставить это работать для одного термина, но я надеялся создать макрос, который извлек бы все значения для всех терминов одновременно.

Набор данных представляет собой столбец (c6: c50) необработанных данных (indicators), а затем 13 столбцов (j6: j50, m6: m50 и т. Д.) (output), где извлеченные значения должны появляются. столбцы K и L (и так далее между начальными 13 столбцами) содержат формулы, основанные на значениях столбца J. поисковый термин для каждого из 13 столбцов находится в ячейке непосредственно над диапазоном (J5, M5 и т. д.).

Код ниже, куда я попал. Целью было создать цикл, который извлекает значения из столбца C в столбец J (цикл на основе i), а затем второй цикл (цикл на основе j), который смещается по столбцам.

Что происходит при запуске, заполняется значение первой ячейки в ячейке J6, за которым следует правильное значение в J7. Затем все последующие извлеченные значения перезаписывают то, что было в J7. Как только цикл для первого термина завершен, он смещается на 3 столбца, извлекает то же значение из J6 в M6 (предположительно, потому что поисковый термин «опрос» не смещается?), Но затем возвращается к перезаписи ячейки J7.

Любая помощь будет принята с благодарностью. 

Sub indicator_charts()

Dim indicators As Range
Dim survey As String
Dim surveyrng As Range
Dim output As Range
Dim survey2 As String
Dim firstcell As Range

Set indicators = Worksheets("Indicator Summary").Range("C6:C50")
Set output = Worksheets("Indicator Summary").Range("j5:j50")
Set surveyrng = Worksheets("Indicator Summary").Range("J5")
Set firstcell = Worksheets("Indicator Summary").Range("J6")

survey = surveyrng.Value

For j = 0 To 36 Step 3
output.Offset(0, j) = output
surveyrng.Offset(0, j) = surveyrng
firstcell.Offset(0, j) = firstcell
    For i = 1 To 46
        If InStr(1, indicators.Cells(i, 1).Value, survey) Then
        survey2 = indicators.Cells(i, 1).Value
            If IsEmpty(firstcell) Then
            firstcell.Value = survey2
            Else
            output.End(xlDown).Offset(1, 0).Value = survey2
            End If
        End If
    Next i
Next j

End Sub

1 Ответ

0 голосов
/ 25 апреля 2018

Я немного изменил ваш код. Должен делать то, что вы хотите сейчас. 

Sub indicator_charts()

Dim indicators As Range
Dim survey As String
Dim surveyrng As Range
Dim output As Range
Dim survey2 As String
Dim firstcell As Range
Dim OutputVar As Variant
Dim SurveyRngVar As Variant
Dim FirstCellVar As Variant

Set indicators = Worksheets("Indicator Summary").Range("C6:C50")
Set output = Worksheets("Indicator Summary").Range("j5:j50")
Set surveyrng = Worksheets("Indicator Summary").Range("J5")
Set firstcell = Worksheets("Indicator Summary").Range("J6")

For j = 0 To 36 Step 3
Set OutputVar = output.Offset(0, j)
Set SurveyRngVar = surveyrng.Offset(0, j)
Set FirstCellVar = firstcell.Offset(0, j)
survey = SurveyRngVar.Value

    For i = 1 To 46
        If InStr(1, indicators(i, 1).Value, survey) Then
        survey2 = indicators(i, 1).Value
            If IsEmpty(FirstCellVar) Then
            FirstCellVar.Value = survey2
            Else
            OutputVar.End(xlDown).Offset(1, 0).Value = survey2
            End If
        End If
    Next i

Next j

End Sub
...