vba自定义函数问题

ntj0512

在excel工作表中，希望得到数量与单价乘积再汇总，用sumproduct函数能够解决数量全是数值的数据，但如果数量中有文本等字符时，就不太好用了，因此希望用自定义函数解决，自己瞎编了一个，但发现在不同工作表中引用后结果都是一样的，网上搜了，也没有找到答案，由于是vba初学者，不知道问题出在哪里，请高手指点

苏子龙

Public Function sbtotal(arr1 As Range) ' 不需要 Public
Application.Volatile                   '用cells时，再加易失是不对的，可以不要加
Dim i&, j&, k&, s As Long
k = arr1.Row
j = arr1.Column
For i = k To k + arr1.Rows.Count - 1
If Cells(i, j) = "/" Or Cells(i, j + 1) = "/" Then '写个函数还要用cells，而且前面还没有指定用哪个工作表，这样就变成活动工作表里的cells了
    i = i + 1
    Else
        If TypeName(Cells(i, j).Value) = "String" Then '其他问题自己动动脑
        s = s + Cells(i, j + 1).Value
        Else
        s = s + Cells(i, j).Value * Cells(i, j + 1).Value
        End If
    End If
Next i
sbtotal = s
End Function

yorkchenshunan

如附件

1. Function sumpro(rg1 As Range, rg2 As Range)
   
2. Dim arr1, arr2, x%, n%, m%
   
3. arr1 = rg1
   
4. arr2 = rg2
   
5. If UBound(arr1) * UBound(arr1, 2) = UBound(arr1) + UBound(arr1, 2) - 1 Then
   
6.     If UBound(arr1) = UBound(arr2) And UBound(arr1, 2) = UBound(arr2, 2) Then
   
7.         For n = 1 To UBound(arr1)
   
8.             For m = 1 To UBound(arr1, 2)
   
9.                 If TypeName(arr1(n, m)) = "String" Then
   
10.                     If arr1(n, m) = "/" Then
    
11.                         arr1(n, m) = 0
    
12.                     Else
    
13.                         arr1(n, m) = 1
    
14.                     End If
    
15.                 End If
    
16.                 If TypeName(arr2(n, m)) = "String" Then
    
17.                     If arr2(n, m) = "/" Then
    
18.                         arr2(n, m) = 0
    
19.                     Else
    
20.                         arr2(n, m) = 1
    
21.                     End If
    
22.                 End If
    
23.                 x = x + arr1(n, m) * arr2(n, m)
    
24.             Next
    
25.         Next
    
26.         sumpro = x
    
27.     Else
    
28.         MsgBox "两参数不符合公式要求"
    
29.     End If
    
30. Else
    
31.     MsgBox "两参数不符合公式要求"
    
32. End If
    
33. End Function

复制代码

ntj0512

谢谢楼上的两位，看来还要加强学习