VBA – 如何遍历列和插入数组公式
我有以下冗余代码：
Sheets("Data").Range("D8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(D3&$C8, client_range & date_range, 0),MATCH(D2, name_range, 0)), ""Error"")" Sheets("Data").Range("E8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(E3&$C8, client_range & date_range, 0),MATCH(E2, name_range, 0)), ""Error"")" Sheets("Data").Range("F8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(F3&$C8, client_range & date_range, 0),MATCH(F2, name_range, 0)), ""Error"")" Sheets("Data").Range("G8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(G3&$C8, client_range & date_range, 0),MATCH(G2, name_range, 0)), ""Error"")" Sheets("Data").Range("H8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(H3&$C8, client_range & date_range, 0),MATCH(H2, name_range, 0)), ""Error"")" Sheets("Data").Range("I8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(I3&$C8, client_range & date_range, 0),MATCH(I2, name_range, 0)), ""Error"")" Sheets("Data").Range("J8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(J3&$C8, client_range & date_range, 0),MATCH(J2, name_range, 0)), ""Error"")" Sheets("Data").Range("K8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(K3&$C8, client_range & date_range, 0),MATCH(K2, name_range, 0)), ""Error"")" Sheets("Data").Range("L8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(L3&$C8, client_range & date_range, 0),MATCH(L2, name_range, 0)), ""Error"")" Sheets("Data").Range("M8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(M3&$C8, client_range & date_range, 0),MATCH(M2, name_range, 0)), ""Error"")" 有没有办法让这个代码更紧凑和可维护的循环在列？
谢谢！
您需要使用单元格而不是Range作为FormulaArray和Address的父级来dynamic计算公式：
Dim C As Long: For C = 4 To 13 ' Column 'D' = Column 4 Sheets("Data").Cells(8,C).FormulaArray = "=IFERROR(INDEX(data_range, MATCH(" & Sheets("Data").Columns(3,C).Address(False, False) & "&$C8, client_range & date_range, 0),MATCH(" & Sheets("Data").Columns(2,C).Address(False, False) & ", name_range, 0)), ""Error"")" Next C
修订代码：
Dim C As Long: For C = 4 To 13 ' Column 'D' = Column 4 ActiveSheet.Cells(C, 8).FormulaArray = "=IFERROR(INDEX(data_range, MATCH(" & ActiveSheet.Cells(C, 3).Address(False, False) & "&$C8, client_range & date_range, 0),MATCH(" & ActiveSheet.Cells(C, 2).Address(False, False) & ", name_range, 0)), ""Error"")" Next C
当然，根据您的工作环境，您可能希望使用Sheets（“Data”）而不是ActiveSheet。
这是一个方法去解决它。 任何问题只是问：
Sub DoSomething() Dim sRange1 As String, sRange2 As String, sRange3 As String Dim i As Integer For i = 4 To 13 sRange1 = Cells(8, i).Address sRange2 = Cells(3, i).Address sRange3 = Cells(2, i).Address Sheets("Data").Range(sRange1).FormulaArray = "=IFERROR(INDEX(data_range, MATCH(" & sRange2 & "&$C8, client_range & date_range, 0),MATCH(" & sRange3 & ", name_range, 0)), ""Error"")" Next i End Sub
我会使用范围属性偏移量在这里看到https://msdn.microsoft.com/en-us/library/office/ff840060.aspx 。 根据循环编辑的增量进行偏移：
for i = 0 to range.("d8").end(xlRight) Sheets("Data").range("d8").offset(0, i).FormulaArray = "=IFERROR(INDEX(data_range, match(Sheets("Data").range("d8").offset(-5,i) & Sheets("Data").range("c8"), client_range & date_range, 0), Match(Sheets("Data").range("d8").offset(-6,i), name_range, 0)), ""Error"")" next i
该函数从单元格D8开始，并在列中不断偏移1; 所以它把公式分成第一次迭代的d8，第二次的e8，第三次的f8，依此类推。
看来，在这些迭代中的每一个上，您都在寻找位于该列的第三行（第一次迭代中的IE D3）和第二行（第二次迭代中的IE D2）的数据。 基本上我提出的解决scheme用每个单元格引用replace
表（ “数据”）。范围（ “D8”）。偏移量（X，i）的
其中X根据您想要从中检索信息的哪一行进行更改; 在你写了第8行（X = 0），第3行（x = -5）或第2行（x = -6）的情况下，
我不认为你需要循环。 .Formula调整没有$的相对行和列
Sheets("Data").Range("D8:M8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(D3&$C8, client_range & date_range, 0),MATCH(D2, name_range, 0)), ""Error"")"
更新
For Each c in Split("DEFGHIJKLM") Sheets("Data").Range(c & "8").FormulaArray = "=IFERROR(INDEX(data_range, MATCH(" & c & _ "3&$C8, client_range & date_range, 0),MATCH(" & c & "2, name_range, 0)), ""Error"")" Next
要么
For Each cell in Sheets("Data").Range("D8:M8") c = Chr(64 + cell.column) ' Asc("A") is 65 ' or c = Left(cell.Address(0,0)) cell.FormulaArray = "=IFERROR(INDEX(data_range, MATCH(" & c & _ "3&$C8, client_range & date_range, 0),MATCH(" & c & "2, name_range, 0)), ""Error"")" Next