[已解决]VBA只用数组不用字典把B列不相同名字 提取到E2开始输出

laoau138

VBA只用数组不用字典把B列不相同名字   提取到E2开始输出

最佳答案

月排行榜 / 总排行榜

idnoidno

2017-7-8 17:23

1. Sub QE()
   
2. Dim ar, br
   
3. Dim i As Long, j As Long, k As Long, sum
   
4. Dim rg As Range
   
5. 
   
6. ar = Range("b1:c" & Cells(Rows.Count, 2).End(xlUp).Row)
   
7. Set rg = Range("e1:g" & Cells(Rows.Count, 5).End(xlUp).Row)
   
8. br = rg
   
9. For i = 2 To UBound(br)
   
10.     k = 1
    
11.     sum = 0
    
12.     For j = 2 To UBound(ar)
    
13.         If br(i, 1) = ar(j, 1) Then
    
14.             br(i, 2) = k
    
15.             k = k + 1
    
16.             sum = sum + ar(j, 2)
    
17.         End If
    
18.     Next j
    
19.     br(i, 3) = sum
    
20. Next i
    
21. rg = br
    
22. Set rg = Nothing
    
23. End Sub

复制代码

大哥，順便把總和也一起補上
雖然晚了回復

跳转到最佳答案楼层

chart888

1. Sub 数组去重复()
   
2. Dim arr(), brr
   
3. Dim i&, j&, k&
   
4. arr = Range("b2:B" & Cells(Rows.Count, 2).End(3).Row).Value
   
5. ReDim brr(1 To UBound(arr), 1 To 1)
   
6. k = 0
   
7. For i = 1 To UBound(arr)
   
8.     For j = 1 To k
   
9.         If brr(j, 1) = arr(i, 1) Then Exit For
   
10.     Next j
    
11.     If j = k + 1 Then k = k + 1: brr(k, 1) = arr(i, 1)
    
12. Next i
    
13. Range("E2").Resize(UBound(brr), 1) = brr
    
14. End Sub

复制代码

chart888

我想给你改个名字叫讨厌字典，喜欢数组

idnoidno

1. Sub QE()
   
2. Dim ar, br
   
3. Dim i As Long, j As Long, k As Long, sum
   
4. Dim rg As Range
   
5. 
   
6. ar = Range("b1:c" & Cells(Rows.Count, 2).End(xlUp).Row)
   
7. Set rg = Range("e1:g" & Cells(Rows.Count, 5).End(xlUp).Row)
   
8. br = rg
   
9. For i = 2 To UBound(br)
   
10.     k = 1
    
11.     sum = 0
    
12.     For j = 2 To UBound(ar)
    
13.         If br(i, 1) = ar(j, 1) Then
    
14.             br(i, 2) = k
    
15.             k = k + 1
    
16.             sum = sum + ar(j, 2)
    
17.         End If
    
18.     Next j
    
19.     br(i, 3) = sum
    
20. Next i
    
21. rg = br
    
22. Set rg = Nothing
    
23. End Sub

复制代码

大哥，順便把總和也一起補上
雖然晚了回復

laoau138

idnoidno 发表于 2017-7-8 17:23
大哥，順便把總和也一起補上
雖然晚了回復

你的代码似乎有问题，它会变化C列数据

laoau138

chart888 发表于 2017-7-8 15:00

你的代码似乎有问题，它会变化C列数据

idnoidno

晚點我回到家檢查一下，等我，哈哈

idnoidno

大哥，CODE沒有問題，是您的數據中，數字的部分有公式(C欄，公式是=RANDBETWEEN(300,500))，要把公式取消，變成數值形式，CODE執行就不會改變C欄的數字了

laoau138

idnoidno 发表于 2017-7-8 21:03
大哥，CODE沒有問題，是您的數據中，數字的部分有公式(C欄，公式是=RANDBETWEEN(300,500))，要把公式取消， ...

没有注意这个

idnoidno

哈哈，題目不是您寫的嗎？
請教，字典的部分，您有比較好的教學可以參考嗎？