Макрос VBA для заполнения ячейки на основе 2 разных полей, соответствующих списку значений

Question

У меня есть кнопка. Я хочу назначить макрос, который при нажатии вводит число 1 в конкретную ячейку на другом листе в той же книге.Этот макрос должен: а) сопоставить значение в ячейке В8 с диапазоном значений в другом столбце листа (G11: G110), а также б) сопоставить значение в ячейке С4 с диапазоном значений в других строках листа (L4: FR4),

Так что, если значение в B8 = 01234, оно будет выполнять функцию типа vlookup на G11: G110.Как только он находит свое совпадение, он смотрит на значение в C4 = "Приложение" и находит это совпадение в L4: FR4.Следует отметить, что в любом поле нет повторяющихся значений, а значения в L4: FR4 являются статическими, тогда как значения в ячейках G11: G110 изменяются при обновлении.

Я пробовал Выбрать дело, если ... И ... Тогда ... и единственное, что я получил, это просто сказать, что если B8 = G11, то бла-бла L11, если B8 = G12, то бла-блаL12

Sub RectangleRoundedCorners1_Click()

Dim sourceSht As Worksheet: Set sourceSht = DataEntry
Dim destSht As Worksheet:   Set destSht = Labels
Dim Selection As Range:     Set Selection = DataEntry.Range("C5")' This is the # 1 I was talking about'
Dim Acct As Range:          Set Acct = DataEntry.Range("B8")
Dim SpecErr As Range:       Set SpecErr = DataEntry.Range("C4")

If (SpecErr.Value = Labels.Range("L4")) And (Acct.Value = Labels.Range("G11")) Then
    Selection.Copy Destination:=Labels.Range("L11")
End If
If (SpecErr.Value = Labels.Range("M4")) And (Acct.Value = Labels.Range("G11")) Then
    Selection.Copy Destination:=Labels.Range("M11")
End If
End Sub

Мне не хватило места в коде, делающем это следующим образом, так как мне нужно перейти от L4 к FR4, а затем сделать это 100 раз, настроив G11 на G12 и L11 на L12 и т. Д.

Лист, содержащий основные данные и кнопку I, называемый DataEntry, и лист, на котором мне нужно найти и в котором введена цифра 1, называется Labels.

Answer 1

Это должен быть VBA? Вы можете сделать это с помощью формулы. В ячейке «Метки» листа L11 используйте эту формулу и копируйте вверх и вниз:

=IF(AND(DataEntry!$B$8=$G11,DataEntry!$B$4=L$4),1,"")

Если это должен быть VBA, то это можно сделать в основном в виде одной строки:

Sub RectangleRoundedCorners1_Click()

    On Error Resume Next    'Ignore errors if any fields are not filled out
    Sheets("Labels").Cells(Evaluate("MATCH(DataEntry!$B$8,Labels!$G:$G,0)"), Evaluate("MATCH(DataEntry!$B$4,Labels!$4:$4,0)")).Value = Sheets("DataEntry").Range("B5").Value
    On Error GoTo 0         'Clear "On Error Resume Next" condition

End Sub

Answer 2

Я думаю, что это то, что вам нужно - вы можете просто пройти по всем столбцам (в вашем случае 12 to 175 представляет от L до FR), а затем выполнить цикл по строкам 11 to 110. Как только вы получите совпадение, ячейкой назначения будет соответствующий столбец и строка в i и j:

Sub RectangleRoundedCorners1_Click()

Dim sourceSht As Worksheet: Set sourceSht = DataEntry
Dim destSht As Worksheet:   Set destSht = Labels
Dim Selection As Range:     Set Selection = DataEntry.Range("C5") ' This is the # 1 I was talking about'
Dim Acct As Range:          Set Acct = DataEntry.Range("B8")
Dim SpecErr As Range:       Set SpecErr = DataEntry.Range("C4")

Dim i As Long, j As Long

For i = 12 To 175 'L to FR
    For j = 11 To 110
        If SpecErr.Value = Labels.Cells(4, i) And Acct.Value = Labels.Cells(j, 7) Then
            Selection.Copy Destination:=Labels.Cells(i, j)
        End If
     Next j
Next i

End Sub