Question

我是编码新手，需要一些帮助。我在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（Sheet 2中B：！B，MATCH（Sheet 1中！A：A，Sheet 2中！A：A，0））

类似的公式位于单元格C到H中。我希望使用按钮自动执行此操作，而不是编写7个公式并将其拖动。这是一个我用非常大的数据集重复了很多的动作。

抱歉，我没有Snap。

Answer 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

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

我在导入宏上执行此操作。这是我的一条线。这会直接将列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))"

让你的公式进入＆＃34; RC＆＃34;格式化只记录自己手动输入的宏。

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

3 个答案: