|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
见附件。
其中若干列求和采用了香川群子的程序,见http://club.excelhome.net/thread-977830-1-1.html
Sub tt()
Dim arr(), i%, j%
Dim dic As Object
arr = Sheet1.Range("a1").CurrentRegion
m = UBound(arr): n = UBound(arr, 2)
ReDim brr(1 To m, 1 To n)
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To m
If arr(i, 2) = "斤" Then
For j = 3 To n
arr(i, 2) = "公斤"
arr(i, j) = arr(i, j) / 2
Next j
End If
Next i
'-------------------------------------------'将单位斤转换为公斤,放入表【斤转换为公斤】中
With Sheet2
.Range("a1").CurrentRegion.Offset(1) = ""
.Range("a1").Resize(m, n).Value = arr
End With
'--------------------------------------------'如果不要这张表,可以删除这段程序
For i = 1 To m
t = dic(arr(i, 1))
If t = "" Then
k = k + 1: dic(arr(i, 1)) = k: t = k
brr(k, 1) = arr(i, 1): brr(k, 2) = arr(i, 2)
End If
For j = 3 To n
brr(t, j) = brr(t, j) + arr(i, j)
Next
Next
With Sheet3
.Range("a1").CurrentRegion.Offset(1) = ""
.Range("a1").Resize(k, n).Value = brr
End With
End Sub
|
|