Столбец на основе заголовка в Excel VBA

Question

Формула:

=IF(RC[2]=""Debit"",RC[-1],IF(RC[2]=""Credit"",-RC[-1]))

Говорит, что проверит, является ли значение дебет / кредит в столбце M, и положит (-) в столбец K.

У меня вопрос: а что если мы не знаем, что дебет / кредит только в столбце М? Что мы дадим вместо RC[2]? Мы только знаем, что заголовок этого столбца будет "Дебет или кредит".

Мой полный код:

Rows("1:1").Select
 Selection.Find(What:="AMNT", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select

  ActiveCell.Offset(1, 0).Select 'Noting but K2
  Range(Cells(2, ActiveCell.Column), Cells(lastRow, ActiveCell.Column)).FormulaR1C1 = _
    "=IF(RC[2]=""Debit"",RC[-1],IF(RC[2]=""Credit"",-RC[-1]))"
ActiveCell.EntireColumn.Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Application.CutCopyMode = False

Answer 1

Ваш код делает большой выбор, и ничего с этими выборами. В лучшем случае лучше всего избегать использования select , поскольку это замедляет ваш код (и в большинстве случаев не требуется).

В этом коде предполагается, что рабочий лист равен Sheet1, если не меняйте ссылку на лист в соответствии с вашим собственным листом.

Я создаю переменные для всех чисел и диапазонов, которые я хочу использовать, что облегчает чтение и следование коду (так как переменная может быть описательно названа).

Я нахожу последний столбец в строке 1 (при условии, что это строка заголовка), что означает, что код будет работать одинаково, если столбцы добавлены или удалены.

Как только заголовок столбца найден, мы присваиваем номер столбца кредита или дебета DebtCreditColumn и используем его для определения нашего HeaderRange.

Затем мы делаем то же самое для AMNTColumn.

Я добавил пару операторов If...Then для отображения MsgBox и отмены кода, если любое из значений равно 0 (что означает, что заголовки не были найдены).

Затем минус AMNTColumn от DebtCreditColumn, чтобы получить разницу и присвоить FormulaReferenceColumn.

Затем найдите LastRow в Debit or Credit и установите наши TargetRange для столбец «AMNT» от строки 2 до LastRow (LastRow не был определен в вашем коде, поэтому я предположил, что это столбец «Дебет или кредит»).

Наконец, включите FormulaReferenceColumn в наш Формула, которая будет написана на наш TargetRange.

Вот так:

Sub ParanTest()

Dim DebtCreditColumn As Long
Dim AMNTColumn As Long
Dim LastColumn As Long
Dim FormulaReferenceColumn As Long
Dim LastRow As Long
Dim HeaderRange As Range
Dim TargetCell As Range
Dim TargetRange As Range

With Sheet1
    LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
    Set HeaderRange = .Range(.Cells(1, 1), .Cells(1, LastColumn))
End With

For Each TargetCell In HeaderRange
    If TargetCell.Value Like "Debit or Credit" Then
        DebtCreditColumn = TargetCell.Column
        Exit For
    Else
        'Go To Next Cell
    End If
Next TargetCell

For Each TargetCell In HeaderRange
    If TargetCell.Value Like "AMNT" Then
        AMNTColumn = TargetCell.Column
        Exit For
    Else
        'Go To Next Cell
    End If
Next TargetCell

'In case the column can't be found, this will notify you and abort the code to avoid errors.
If DebtCreditColumn = 0 Then
    MsgBox "A column header 'Debit or Credit' could not be found.", vbOKOnly, "No column found!"
Exit Sub
End If

'In case the column can't be found, this will notify you and abort the code to avoid errors.
If AMNTColumn = 0 Then
    MsgBox "A column header 'AMNT' could not be found.", vbOKOnly, "No column found!"
Exit Sub
End If

FormulaReferenceColumn = DebtCreditColumn - AMNTColumn

With Sheet1
    LastRow = .Cells(Rows.Count, DebtCreditColumn).End(xlUp).Row    'You can define whatever column works best for you
    Set TargetRange = .Range(.Cells(2, AMNTColumn), .Cells(LastRow, AMNTColumn))
End With

TargetRange.FormulaR1C1 = "=IF(RC[" & FormulaReferenceColumn & "]=""Debit"",RC[-1],IF(RC[" & FormulaReferenceColumn & "]=""Credit"",-RC[-1]))"


End Sub