如何用VBA剔除列表中的重复项及求和

cui26896

mai51 发表于 2020-10-17 17:52
老师，有个小问题帮忙追加一下，就是D列求和结果四舍五入只保留整数位，不要小数位了。我不太懂编码，劳 ...

找准位置，加上红色的几句，就ok了。
        End If
    Next
    For i = 1 To k2
      arr(i, 4) = Application.Round(arr(i, 4), 0)
    Next
  With Sheets(1)
    .Range("o2").Resize(k2, UBound(arr, 2)) = arr
    .Range("o2:r" & k2 + 1).Sort key1:=.Range("q2"), order1:=xlAscending, Header:=xlNo
    .Range("o2:r" & k2 + 1).Sort key1:=.Range("p2"), order1:=xlAscending, Header:=xlNo
    .Range("o2:r" & k2 + 1).Sort key1:=.Range("o2"), order1:=xlAscending, Header:=xlNo
  End With

mai51

cui26896 发表于 2020-10-17 14:23
Sub test()
Dim arr, brr, d, d2, i%, j%, j2%, k, k2, s
  Set d = CreateObject("Scripting.Dictionary ...

老师，如下这个问题能否用VBA完成组合，见下图：

cui26896

按你新上传附件要求的附件
如何用VBA合并某列数据列表.zip (17.28 KB, 下载次数: 23)

2020-10-17 19:58 上传

点击文件名下载附件

mai51

cui26896 发表于 2020-10-17 19:58
按你新上传附件要求的附件

老师，10楼那个问题能否帮忙修改一下，谢谢了。

cui26896

10楼加了个循环
如何用VBA剔除重复项及求和.zip (19.1 KB, 下载次数: 28)

2020-10-17 20:37 上传

点击文件名下载附件

shi353

Sub test1()
Set d = CreateObject("Scripting.Dictionary")
[O1].CurrentRegion.ClearContents
arr = [A1].CurrentRegion
For i = 2 To UBound(arr)
    s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
    d(s) = d(s) + arr(i, 4)
Next
'--------------------------------
[O1:R1].Value = [A1:D1].Value
t1 = d.keys: t2 = d.items
[O2].Resize(UBound(t1) + 1) = Application.Transpose(t1)
[R2].Resize(UBound(t1) + 1) = Application.Transpose(t2)
'--------------------------------
brr = [O1].CurrentRegion
For i = 2 To UBound(brr)
    x = Split(brr(i, 1), "|")
    brr(i, 1) = x(0): brr(i, 2) = x(1): brr(i, 3) = x(2)
    brr(i, 4) = Round(brr(i, 4), 0)
Next
[O1].Resize(UBound(brr), UBound(brr, 2)) = brr
'--------------------------------
[O1].CurrentRegion.Sort key1:=[O1], order1:=1, header:=xlYes
End Sub

shi353

mai51 发表于 2020-10-17 16:16
这要外部链接，还是用VBA吧，处理时间应该不会快多少

sql的設定連接及語法對初學vba的人 的確很難
但學了一陣子後 一定要學sql
會發現sql真的是vba的法寶之1
另1個法寶是 regex 正則 但這個對初學者比sql更難吧!

准提部林

mai51 发表于 2020-10-17 18:46
老师，如下这个问题能否用VBA完成组合，见下图：

Sub TEST_A2()
Dim Arr, Brr, i&, j%, k%, N&
[N2:N6000].ClearContents
Arr = Range([E1], [A65536].End(3))
Brr = [B1:E1].Resize(UBound(Arr) * 2)
For i = 2 To UBound(Arr)
    For j = 1 To 2
        N = N + 1:  Brr(N, 1) = Arr(i, j)
        For k = 2 To 4: Brr(N, k) = Arr(i, k + 1):  Next k
    Next j
Next i
With [N2].Resize(N, 4)
     .Value = Brr
     .Sort key1:=.Item(1), order1:=xlAscending, Header:=xlNo
End With
End Sub

blackttea1

学习啦 ，谢谢

cui26896

shi353 发表于 2020-10-18 08:57
sql的設定連接及語法對初學vba的人 的確很難
但學了一陣子後 一定要學sql
會發現sql真的是vba的法寶之1 ...

说得完全正确，只是学了以后，一定要用，不然，学得再好，很快就忘记了。用到时，等于又重新再学一遍。