Как найти значение в столбце и вставить диапазоны из других листов в соседние столбцы

Question

Конечной целью моего проекта является то, что пользователь сможет выбрать значение из ComboBox, чтобы заполнить отчет на вкладке «Сводка».Отчет будет состоять из 3, 3 диапазонов ячеек (разделенных на 3 диапазона 1x3 на 3 отдельных листах).

Я хочу найти строку со значением, выбранным пользователем в ComboBox, а затем установить 9 ячеек справа от этого значения, равного значениям в упомянутом ранее диапазоне.

Я попробовал несколько разных способов сделать это, но я включу код, над которым я работал в последнее время, ниже:

Private Sub OKButton1_Click()
Dim userValue, rangeOne, rangeTwo, rangeThree
Dim i As Long

i = 4


userValue = ComboBox1.Value
Set rangeOne = Sheets("Sheet2").Range(Range("F23:H23")
Set rangeTwo = Sheets("Sheet3").Range("F90:H90")
Set rangeThree = Sheets("Sheet4").Range("F17:H17")



While Sheets("Reports").Range(cells(i,1)).Value <> "" 
      If Sheets("Reports").Range(cells(i, "A")).Value = "userValue" Then

         Set Sheets("Reports").Range(Cells(i, "B:E")) = rangeOne
         Set Sheets("Reports").Range(Cells(i, "F:I")) = rangeOne
         Set Sheets("Reports").Range(Cells(i, "J:M")) = rangeOne
      End If
      i = i + 1
Wend
Unload UserForm2
End Sub 

Есть какие-нибудь идеи о том, как я могу улучшить это или заставить его работать?На данный момент получаю 1004 ошибки.

Answer 1

For x = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
    If InStr(1, Cells(x, 1), UserValue) > 0 Then
        ws1.Cells(x, 2) = ws2.Cells(23, 6).Value
        ws1.Cells(x, 3) = ws2.Cells(23, 7).Value
        ws1.Cells(x, 4) = ws2.Cells(23, 8).Value

        ws1.Cells(x, 6) = ws3.Cells(90, 6).Value
        ws1.Cells(x, 7) = ws3.Cells(90, 7).Value
        ws1.Cells(x, 8) = ws3.Cells(90, 8).Value

        ws1.Cells(x, 10) = ws4.Cells(18, 6).Value
        ws1.Cells(x, 11) = ws4.Cells(18, 7).Value
        ws1.Cells(x, 12) = ws4.Cells(18, 8).Value
    Else:
    End If
Next x

Выше я работаю вместо цикла while.

Answer 2

Два слова совета при работе с Excel:

1. всегда создайте переменные для каждого листа / книги, с которыми вам нужно работать
2. Избегайте использования диапазонов и объектов, если можете. Намного проще перебирать отдельные ячейки, используя массив и цикл for, как я делал ниже.

Я был немного смущен тем, что именно вам нужно было сделать, поэтому вам нужно будет немного изменить это, чтобы он соответствовал вашим диапазонам / туда, куда вы хотите, чтобы данные шли. Если вы не уверены или вам нужна дополнительная помощь, дайте мне знать, и я обновлю это.

Dim userValue
Dim xrow As Long, ws1 As Worksheet, ws2 As Worksheet, ws3 as Worksheet, ws4 as Worksheet
Dim arrData() as variant

set ws1 = Worksheets("Report")
set ws2 = Worksheets("Sheet2")
set ws3 = Worksheets("Sheet3")
set ws4 = Worksheets("Sheet4")

userValue = ComboBox1.Value
xrow = 1

ws2.activate
'the InStr function checks if the first condition contains the second, and when it does, it returns 1, which in turn triggers the if statement
for x = 1 To ws2.Cells(rows.count, 1).end(xlup).row
    if InStr(1, Cells(x, 1), userValue) > 0 Then
        arrData(0) = ws2.Cells(x, 2).value
        arrData(1) = ws2.Cells(x, 3).value
        arrData(2) = ws2.Cells(x, 4).value
    else:
    end if
next x

ws3.activate
for x = 1 To ws3.Cells(rows.count, 1).end(xlup).row
    if InStr(1, Cells(x, 1), userValue) > 0 Then
        arrData(3) = ws3.Cells(x, 2).value
        arrData(4) = ws3.Cells(x, 3).value
        arrData(5) = ws3.Cells(x, 4).value
    else:
    end if
next x

ws4.activate
for x = 1 To ws4.Cells(rows.count, 1).end(xlup).row
    if InStr(1, Cells(x, 1), userValue) > 0 Then
        arrData(6) = ws4.Cells(x, 2).value
        arrData(7) = ws4.Cells(x, 3).value
        arrData(8) = ws4.Cells(x, 4).value
    else:
    end if
next x

ws1.activate
ws1.Cells(xrow, 1) = userValue
for y = 0 To 8
    ws1.Cells(xrow, y+1).value = arrData(y)
next y
xrow = xrow + 1