Question

我有一个按钮我想为其指定一个宏，当单击时，将数字1输入到同一工作簿中另一个工作表上的特定单元格中。此宏需要a）将单元格B8中的值与另一个工作表列中的值范围（G11：G110）匹配，并且b）将单元格C4中的值与另一个工作表行中的值范围匹配（L4：FR4）。

因此，如果B8中的值= 01234，它将在G11：G110上执行vlookup类型函数。一旦找到匹配，它就会查看C4 =“Application”中的值，并在L4：FR4中找到它匹配。我应该注意，在任何字段中都没有重复值，L4：FR4中的值是静态的，而单元格G11：G110中的值在刷新时会发生变化。

我尝试过Select Case，If ...然后......然后......我唯一能做的就是说如果B8 = G11那么等等等等如果B8 = G12那么blah blah 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，然后通过将G11调整到G12＆amp; L11到L12等。

保存主数据的工作表和名为DataEntry的按钮I，以及我需要查找并输入1的工作表称为标签。

Answer 1

我认为这就是您所需要的 - 您可以遍历所有列（在您的情况下，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

Answer 2

这必须是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

VBA宏根据与值列表匹配的2个不同字段填充单元格

2 个答案: