根据标题名称将两列相乘

Question

我试图根据标题名称将两列相乘（可以每次更改位置-因此固定的单元格范围不起作用）。

到目前为止，我收到了以下内容

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行（我需要它逐行计算）的事实。

所需输出应类似于：

Answer 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

Answer 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 ... Next循环中调用它，然后将结果写入R和C定义的单元格即可，其中行号R由循环提供，并且C可以从MATCH函数获得，如我的函数所示。如果以这种方式使用，则不需要行Application.Volatile。

Answer 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")

尝试一下，让我知道它是否有效。我无法测试。