VBA 代码填充 7 个相邻单元格中的索引匹配函数

Posted 2023-02-24

【中文标题】VBA 代码填充 7 个相邻单元格中的索引匹配函数

【英文标题】：VBA code to fill down index-match functions in 7 adjacent cells

【发布时间】：2015-12-09 13:59:40

【问题描述】：

我是编码新手，需要一些帮助。我在 Excel 2013 中创建了一个更新按钮，它将使用 A 列中的值使用另一个电子表格中的索引和匹配来填充 B 到 H 列中的值。 A 列中的条目数会有所不同，包含 B 到 H 列值的电子表格有超过 6,000 行和许多列。

我希望我编写的代码填写 A 列中的最后一个条目。

Private Sub cmdUpdate_Click()
    With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
    End With
End Sub

提前感谢您的帮助，非常感谢。

更新： 我集成了来自@Linga 的代码，如下所示。公式填写 A 列中的最后一个条目，但它只是从第 2 行复制数据。它忽略了连续行中 A 列中的值。

Private Sub cmdUpdateWBID_Att_Click()
       Dim a As String
       a = ActiveCell.Row
       With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
       End With
       Range("A2").Select
       Selection.End(xlDown).Select
       Range("B" & a & ":H" & a).Select
       Range(Selection, Selection.End(xlUp)).Select
       Selection.FillDown

End Sub

更新： 我在单元格 B 到 H 中编写了 Excel 索引和匹配公式的 VBA 形式。以下公式位于单元格 B 中；

=INDEX(Sheet2!B:B,MATCH(Sheet1!A:A,Sheet2!A:A,0))

一个类似的公式位于单元格 C 到 H 中。我想用一个按钮自动执行此操作，而不是编写 7 个公式并将它们向下拖动。这是我在非常大的数据集上经常重复的操作。

抱歉，我没有 Snap。

【参考方案1】：

在应用从 B 到 H 的公式后使用这个宏，希望这是你所期望的。

Private Sub cmdUpdateWBID_Att_Click()
       Dim a As Integer
       
       With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
      End With  

       Range("A2").Select
       Selection.End(xlDown).Select
       a = ActiveCell.Row
       Range("B" & a & ":H" & a).Select
       Range(Selection, Selection.End(xlUp)).Select
       Selection.FillDown
   
End Sub

【讨论】：

我试过你的宏，我得到一个“a”的变量未定义错误

我集成了您的代码，如下所示。公式在 A 列的最后一个条目处停止，但它从第 2 行填充相同的数据。它没有根据连续行中 A 列中的值应用公式。

抱歉，我不知道如何在评论框中添加代码。

即使进行了这些更改，我也得到了相同的结果。虽然公式填写完毕，但他们只在 A2 中查找 Match 函数。我需要找到一种方法每次将单元格 A2 增加 1，直到到达 A 列中的最后一个条目。感谢您对此提供的帮助。

请稍候，我会更新代码并回复您。您能否使用从 B 到 H 列使用的公式（不是 VB 格式）更新您的问题。如果可能的话，提供 snap :)

【参考方案2】：

我在使用@Linga 的代码时遇到的问题是我的代码将值放在第 2 行，而他的代码填充了这些值。我需要将公式放在行中，然后@Linga 的代码就会像我想要的那样填写。一位同事用我的代码引导我朝着正确的方向前进。最后几行代码允许我从单元格中删除公式并保留值。 @Linga 的回答完全符合我的要求。

Private Sub cmdUpdateWBID_Att_Click()
Dim a As Integer
Range("B2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C,MATCH(Sheet1!RC[-1],Sheet2!C[-1],0))"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[5],MATCH(Sheet1!RC[-2],Sheet2!C[-2],0))"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[5],MATCH(Sheet1!RC[-3],Sheet2!C[-3],0))"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[2],MATCH(Sheet1!RC[-4],Sheet2!C[-4],0))"
Range("F2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[6],MATCH(Sheet1!RC[-5],Sheet2!C[-5],0))"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[-3],MATCH(Sheet2!RC[-6],Sheet2!C[-6],0))"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[-3],MATCH(Sheet1!RC[-7],Sheet2!C[-7],0))"
Range("A2").Select
Selection.End(xlDown).Select
a = ActiveCell.Row
Range("B" & a & ":H" & a).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

【参考方案3】：

我在导入宏上做这件事。这是我的一条线。 这直接将A 列中的公式应用到一个区域中。它从A2 开始，因为有一个标题行并使用TableRange.Rows.Count 来获取表格的底部。了解自己的底线，但效果最好。

MaxRow = TableRange.Rows.Count
' "DATE"
Range("A2:A" & MaxRow).FormulaR1C1 = "=IF(RC[4]="""","""",DATE(YEAR(RC[4]),MONTH(RC[4]),1))"

要获得“RC”格式的公式，只需记录自己手动输入的宏即可。