vba 范围乘以范围
vba Multiply Range with Range
我想将 P 列的单元格与 M 列的单元格相乘,并将 P 列的内容替换为相应的乘积。之后我想对 Q 和 N 列做同样的事情。
我一直在努力查找这个问题,最接近的解决方案是:VBA multiply two named ranges
不幸的是,在 运行 通过第一列并计算它之后,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
如有任何帮助,我们将不胜感激。
编辑:阅读 后,我将代码更改为:
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 - 类型不匹配 的解释是 arrf_e = 错误 2402.经过快速研究,这应该意味着该数组包含 #NA - 但它没有。
点击调试后,标记的行是
results(x) = arr_e * arrf_e
尝试改用下面的代码。我还添加了注释来解释每个步骤:)
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 行的随机值对其进行了测试,它运行良好。
我想将 P 列的单元格与 M 列的单元格相乘,并将 P 列的内容替换为相应的乘积。之后我想对 Q 和 N 列做同样的事情。
我一直在努力查找这个问题,最接近的解决方案是:VBA multiply two named ranges
不幸的是,在 运行 通过第一列并计算它之后,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
如有任何帮助,我们将不胜感激。
编辑:阅读
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 - 类型不匹配 的解释是 arrf_e = 错误 2402.经过快速研究,这应该意味着该数组包含 #NA - 但它没有。
点击调试后,标记的行是
results(x) = arr_e * arrf_e
尝试改用下面的代码。我还添加了注释来解释每个步骤:)
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 行的随机值对其进行了测试,它运行良好。