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

我是编码新手，需要一些帮助。 我在Excel 2013中创build了一个更新button，它将使用列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（Sheet 2中B：！B，MATCH（Sheet 1中！A：A，Sheet 2中！A：A，0））

一个类似的公式坐在单元格C到H.我想用一个button来自动化这个，而不是写7个公式并拖拽它们。 这是一个非常大的数据集重复了很多的操作。

对不起，我没有Snap。

Answer 1

应用B到H的公式后使用这个macros，希望这是你的预期。

 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 

Answer 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 

Answer 3

我在导入macros上做这件事。 这是我的一行。 这直接将列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”格式获得您的公式，只需logging一下您自己手动input的macros。