时间戳

首页 > 解决方案 > vba 将范围与范围相乘

excel - vba 将范围与范围相乘

问题描述

我想将 P 列的单元格与 M 列中的单元格相乘，并将 P 列的内容替换为相应的产品。之后我想对列 Q 和 N 做同样的事情。

我一直在尝试查找这个问题，最接近的解决方案是：VBA 将两个命名范围相乘

不幸的是，在运行第一列并计算之后，Excel 给了我一个运行时错误 13 - 类型不匹配。

我的代码：

Sub rechnen_mod()

Dim aud_y As Range
Dim soc_r As Range
Dim mp_y As Range
Dim mp_r As Range

Set aud_y = Sheets("MRP score template").[P11:P1000]
Set soc_r = Sheets("MRP score template").[Q11:Q1000]
Set mp_y = Sheets("MRP score template").[M11:M1000]
Set mp_r = Sheets("MRP score template").[N11:N1000]

For i = 1 To Range("P").End(xlDown).Row
    aud_y(i, 1) = aud_y(i, 1) * mp_y(i, 1)
Next i

For j = 1 To Range("Q").End(xlDown).Row
    soc_r(j, 1) = soc_r(j, 1) * mp_r(j, 1)
Next j

End Sub

任何帮助将不胜感激。

编辑：阅读 <stackoverflow.com/a/22056347/11231520> 后，我将代码更改为：

Public Sub array1()

Dim x As Long
Dim arr
Dim arr_e
Dim arrf
Dim arrf_e
Dim results
Dim r As Range

arr = Sheets("MRP score template").[P11:P473]
arrf = Sheets("MRP score template").[M11:M473]

ReDim results(1 To UBound(arr) * UBound(arrf))

For Each arr_e In arr
    For Each arrf_e In arrf
        x = x + 1
        results(x) = arr_e * arrf_e
    Next arrf_e
Next arr_e

Set r = Sheets("calc").Range("A1:A" & UBound(results))

r = Application.Transpose(results)

End Sub

Excel 给了我一个运行时错误 13 - type mismatch的解释，arrf_e = error 2402。经过快速研究，这应该意味着该数组包含#NA - 但它没有。

点击调试后，标记的行是

结果（x）= arr_e * arrf_e

标签： excelvbamultiplication

解决方案

尝试改用下面的代码。我还添加了注释来解释每个步骤:)

Option Explicit

Public Sub rechnen_mod()
    Dim mp_y() As Variant
    Dim mp_r() As Variant
    Dim aud_y() As Variant
    Dim soc_r() As Variant
    Dim arrResult_P() As Variant
    Dim arrResult_Q() As Variant
    Dim iLastRow As Integer
    Dim iSizeArrays As Integer
    Dim iIndexSearch As Integer
    
    With ThisWorkbook.Worksheets("MRP score template")
        ' Find last row of table, replace it with fixed value if you prefer
        iLastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        ' Store data in arrays
        mp_y = .Range("M11", "M" & iLastRow).Value
        mp_r = .Range("N11", "N" & iLastRow).Value
        aud_y = .Range("P11", "P" & iLastRow).Value
        soc_r = .Range("Q11", "Q" & iLastRow).Value
        
        ' Calculate size of arrays
        iSizeArrays = UBound(mp_y) - LBound(mp_y) + 1
        
        ' ReDim result arrays according to iSizeArrays
        ReDim arrResult_P(1 To iSizeArrays)
        ReDim arrResult_Q(1 To iSizeArrays)
        
        ' Calculate result values
        For iIndexSearch = 1 To iSizeArrays
            arrResult_P(iIndexSearch) = mp_y(iIndexSearch, 1) * aud_y(iIndexSearch, 1)
            arrResult_Q(iIndexSearch) = mp_r(iIndexSearch, 1) * soc_r(iIndexSearch, 1)
        Next iIndexSearch
        
        ' Write results in the worksheet
        .Range("P11", "P" & iLastRow) = Application.WorksheetFunction.Transpose(arrResult_P)
        .Range("Q11", "Q" & iLastRow) = Application.WorksheetFunction.Transpose(arrResult_Q)
    End With
End Sub

我用 250 行的随机值对其进行了测试，它运行良好。

推荐阅读