Умножение двух столбцов на основе имени заголовка

#excel #vba

#excel #vba

Вопрос:

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

Пока что я получил следующую часть

 Dim ws As Worksheet
Dim lrow As Long
Dim Amount, Bill, USD As Range
Dim Rngheaders As Range

Set ws = ThisWorkbook.Sheets("CSV Data PR")
Set Rngheaders = ws.Range("1:1")
lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1

Set Amount = ws.Rows(1).Find(What:="Amount")
Set Bill = ws.Rows(1).Find(What:="Bill.qty")
Set USD = ws.Rows(1).Find(What:="In USD")

ws.Range(USD.Address).Offset(1, 0).Resize(lrow) = Range(Amount.Address).Offset(1, 0) * Range(Bill.Address).Offset(1, 0)
  

Это работает, за исключением того факта, что он вычисляет только строку 2 (мне это нужно для вычисления строка за строкой).

Желаемый результат должен выглядеть примерно так:

Вывод

Ответ №1:

Вам нужно будет добавить цикл для циклического просмотра каждой строки. Вы выполнили часть работы, найдя последнюю строку. Вы также установили для первой строки значение Rngheaders , но не использовали.

 Dim ws As Worksheet
Dim lrow As Long
Dim AmountCol as Long
Dim BillCol as Long
Dim USDCol as Long
Dim Rngheaders As Range
Dim x as long

Set ws = ThisWorkbook.Sheets("CSV Data PR")
Set Rngheaders = ws.Range("1:1")
lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

AmountCol = Rngheaders.Find(What:="Amount").Column
BillCol = Rngheaders.Find(What:="Bill.qty").Column
USDCol = Rngheaders.Find(What:="In USD").Column

For x= 2 to lrow
     ws.Cells(x,USDCol) = ws.Cells(x, AmountCol) * ws.Cells(x, BillCol)
Next x
  

Комментарии:

1. Мне это не нужно, но я сохраняю этот код на всякий случай. Мне это нравится, так просто, аккуратно и точно. Не поклонник других ответов, вызывающих функции, и чего-то еще.

2. Большое спасибо! Именно то, что я искал, и действительно — понятия не имею, почему я не использовал строку ссылки заголовка.

Ответ №2:

Пожалуйста, рассмотрите возможность использования пользовательской функции для ваших целей. Вставьте код функции в стандартный модуль кода.

 Function BillTotal(R As Long) As Double
    ' 07 Mar 2019
    ' returns -1 in case of error

    Dim Amt As Long
    Dim Qty As Long

    Application.Volatile
    On Error Resume Next
    Amt = Application.WorksheetFunction.Match("amount", Rows(1), 0)
    If Err.Number = 0 Then
        Qty = Application.WorksheetFunction.Match("bill.qty", Rows(1), 0)
    End If
    If Err Then
        BillTotal = -1
    Else
        BillTotal = Val(Cells(R, Amt).Value) * Val(Cells(R, Qty).Value)
    End If
End Function
  

В ячейке, в которой вы хотите получить результат, запишите вызов функции следующим образом.

 =BillTotal(Row())
  

В качестве альтернативы вы можете использовать ту же функцию для реализации вашей первоначальной идеи. Просто вызовите это в For … Следующий цикл и запишите результат в ячейку, определяемую R и C, где номер строки R предоставляется циклом, а C может быть получен из функции СОПОСТАВЛЕНИЯ, как показано в моей функции. При использовании таким образом строка Application.Volatile не потребовалась бы.

Ответ №3:

Попробуйте этот код:

 Dim ws As Worksheet
Dim lrow As Long
Dim Amount As Range
Dim Bill As Range
Dim USD As Range
Dim Rngheaders As Range
Dim counter As Integer

Set ws = ThisWorkbook.Sheets("CSV Data PR")
Set Rngheaders = ws.Range("1:1")
lrow = ws.Cells(Rows.count, 1).End(xlUp).Row - 1

Set Amount = ws.Rows(1).Find(What:="Amount")
Set Bill = ws.Rows(1).Find(What:="Bill.qty")
Set USD = ws.Rows(1).Find(What:="In USD")


For counter = 1 To lrow
    USD.Offset(counter, 0).Value = Amount.Offset(counter, 0).Value * Bill.Offset(counter, 0).Value
Next counter
  

Я устанавливаю тип переменной для диапазонов сумм, счетов и долларов США

Поскольку это уже диапазоны, вы можете ссылаться на них напрямую. Нет необходимости использовать Range(USD.Address)

Кроме того, вы не используете эту строку: Set Rngheaders = ws.Range("1:1")

Попробуйте и дайте мне знать, сработает ли это. Я не смог это протестировать.