[已解决]不能去重复答案又不对

张雄友

不能去重复答案又不对。

最佳答案

月排行榜 / 总排行榜

xdragon

2014-8-5 21:58

1. Sub test()
   
2.    Dim arr, d As Object, re()
   
3.    Dim irow&, icol%, product, price
   
4.    arr = Range("B2:L" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
5.    Set d = CreateObject("scripting.dictionary")
   
6.    For irow = 1 To UBound(arr)
   
7.        If Not d.exists(arr(irow, 1)) Then Set d(arr(irow, 1)) = CreateObject("scripting.dictionary")
   
8.        For icol = 2 To UBound(arr, 2)
   
9.            If Len(arr(irow, icol)) > 0 Then d(arr(irow, 1))(arr(irow, icol)) = ""
   
10.        Next
    
11.    Next
    
12.    product = d.keys
    
13.    ReDim re(1 To d.Count, 1 To 1)
    
14.    For irow = 0 To UBound(product)
    
15.        re(irow + 1, 1) = product(irow)
    
16.        price = d(product(irow)).keys
    
17.        If UBound(price) + 2 > UBound(re, 2) Then ReDim Preserve re(1 To UBound(re), 1 To UBound(price) + 2)
    
18.        sortnum price
    
19.        For icol = 0 To UBound(price)
    
20.            re(irow + 1, icol + 2) = price(icol)
    
21.        Next
    
22.    Next
    
23.    Range("N10").Resize(UBound(re), UBound(re, 2)) = re
    
24. End Sub
    
25. 
    
26. Sub sortnum(n)
    
27.    Dim i&, j&, t
    
28.    For i = 0 To UBound(n) - 1
    
29.       For j = i + 1 To UBound(n)
    
30.           If n(i) > n(j) Then
    
31.              t = n(i)
    
32.              n(i) = n(j)
    
33.              n(j) = t
    
34.           End If
    
35.       Next
    
36.    Next
    
37. End Sub

复制代码

跳转到最佳答案楼层

xdragon

1. Sub test()
   
2.    Dim arr, d As Object, re()
   
3.    Dim irow&, icol%, product, price
   
4.    arr = Range("B2:L" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
5.    Set d = CreateObject("scripting.dictionary")
   
6.    For irow = 1 To UBound(arr)
   
7.        If Not d.exists(arr(irow, 1)) Then Set d(arr(irow, 1)) = CreateObject("scripting.dictionary")
   
8.        For icol = 2 To UBound(arr, 2)
   
9.            If Len(arr(irow, icol)) > 0 Then d(arr(irow, 1))(arr(irow, icol)) = ""
   
10.        Next
    
11.    Next
    
12.    product = d.keys
    
13.    ReDim re(1 To d.Count, 1 To 1)
    
14.    For irow = 0 To UBound(product)
    
15.        re(irow + 1, 1) = product(irow)
    
16.        price = d(product(irow)).keys
    
17.        If UBound(price) + 2 > UBound(re, 2) Then ReDim Preserve re(1 To UBound(re), 1 To UBound(price) + 2)
    
18.        sortnum price
    
19.        For icol = 0 To UBound(price)
    
20.            re(irow + 1, icol + 2) = price(icol)
    
21.        Next
    
22.    Next
    
23.    Range("N10").Resize(UBound(re), UBound(re, 2)) = re
    
24. End Sub
    
25. 
    
26. Sub sortnum(n)
    
27.    Dim i&, j&, t
    
28.    For i = 0 To UBound(n) - 1
    
29.       For j = i + 1 To UBound(n)
    
30.           If n(i) > n(j) Then
    
31.              t = n(i)
    
32.              n(i) = n(j)
    
33.              n(j) = t
    
34.           End If
    
35.       Next
    
36.    Next
    
37. End Sub

复制代码

张雄友

xdragon 发表于 2014-8-5 21:58

红色代码是什么意思？

Sub 去重复提取价格并从小到大排列()
   Dim arr, d As Object, brr(), irow&, icol%, product, price, tt#
   tt = Timer
   arr = Range("B2:L" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   Set d = CreateObject("scripting.dictionary")
   For irow = 1 To UBound(arr)
       If Not d.exists(arr(irow, 1)) Then Set d(arr(irow, 1)) = CreateObject("scripting.dictionary")
       For icol = 2 To UBound(arr, 2)
           If Len(arr(irow, icol)) > 0 Then d(arr(irow, 1))(arr(irow, icol)) = ""
       Next
   Next
   product = d.keys
   ReDim brr(1 To d.Count, 1 To 1)
   For irow = 0 To UBound(product)
       brr(irow + 1, 1) = product(irow)
       price = d(product(irow)).keys
       If UBound(price) + 2 > UBound(brr, 2) Then ReDim Preserve brr(1 To UBound(brr), 1 To UBound(price) + 2)
       sortnum price
       For icol = 0 To UBound(price)
           brr(irow + 1, icol + 2) = price(icol)
       Next
   Next
   Range("N10").Resize(UBound(brr), UBound(brr, 2)) = brr
   MsgBox "用时" & Format(Timer - tt, "0.00") & "秒"
End Sub
Sub sortnum(n)
   Dim i&, j&, t
   For i = 0 To UBound(n) - 1
      For j = i + 1 To UBound(n)
          If n(i) > n(j) Then
             t = n(i)
             n(i) = n(j)
             n(j) = t
          End If
      Next
   Next
End Sub

xdragon

张雄友 发表于 2014-8-5 22:07
红色代码是什么意思？

Sub 去重复提取价格并从小到大排列()

因为字典赋值到数组后，默认lbound=0，我的re数组的lbound=1 所以需要+1，另外，第一列不是放产品名称了吗？所以，就变成了+2了。