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 для динамического расчета формулы:

 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 

Конечно, вы можете использовать пребывание с таблицами («данные») вместо 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 на второй итерации). В основном мое предлагаемое решение заменяет каждую ссылку на ячейку

Листы ( "данные"). Диапазон ( "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 
Interesting Posts

перейдите через iframe с помощью vba и введите ячейку Excel в текстовый элемент

Вставка полуколонов между непустыми ячейками в диапазоне ответов в Excel

Делать поля зависимыми друг от друга при сортировке и фильтрации

Серийный номер автогенерации

Копировать запрос базы данных Access в таблицу Excel

Улучшите гибкость VBA для преобразования VLOOKUP в INDEX / MATCH

SQL Query, как получить все элементы из одного списка и только похожие из другой таблицы

Excel – Обработка изменений имен флажков

Проверка того, существует ли значение в любом месте в Excel

Формула Excel не принята, но нет причин для ошибки

Добавление листа2 в существующий excelfile из данных sheet1 с pandas python

диапазон excel, похоже, содержит информацию о причине его создания

Вычтите оставшийся час из дня с помощью VBA

Как восстановить элемент управления, который был захвачен за пределы рамки?

Показать следующую доступную дату из списка в excel?

Давайте будем гением компьютера.