[已解决]关于字典的问题

su45

没有最佳，你还可以评分呀！

如履薄冰_﹌

su45 发表于 2014-9-12 23:22
没有最佳，你还可以评分呀！

还有一个问题，如果这个表格里换了别的代码，他对应的供应商可能只有一个，或者产品信息根本就没有这个编码，对应出来的一个供应商也还是红色的，下面的复选框也还是存在的。如果没有编码对应的供应商，就该空白才对，大大帮忙看看呢。

su45

1. Sub 基础表整理()
   
2. On Error Resume Next
   
3.     Dim a, c As Range, Rng As Range, RG As Range
   
4.     Dim Hx As Long, arr, Brr, d As Object, i&
   
5.     With Sheets("产品信息")
   
6.         arr = .Range("a2:b" & .Range("a65536").End(xlUp).Row)
   
7.     End With
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     For i = 1 To UBound(arr)
   
10.         If Not d.exists(arr(i, 1)) Then
    
11.             d(arr(i, 1)) = arr(i, 2)
    
12.         Else
    
13.             d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
    
14.         End If
    
15.     Next i
    
16.     Brr = Sheets("基础表").Range("d2:d" & Sheets("基础表").Range("d65536").End(xlUp).Row)
    
17.     For i = 1 To UBound(Brr)
    
18.         If d.exists(Brr(i, 1)) Then
    
19.             If InStr(d(Brr(i, 1)), ",") Then
    
20.                 With Cells(i + 1, 3).Validation
    
21.                     .Delete
    
22.                     .Add 3, 1, 1, d(Brr(i, 1))
    
23.                 End With
    
24.                 Cells(i + 1, 3) = Split(d(Brr(i, 1)), ",")(0)
    
25.                 Cells(i + 1, 3).Font.ColorIndex = 3
    
26.             Else
    
27.                 Cells(i + 1, 3) = d(Brr(i, 1))
    
28.                 Cells(i + 1, 3).Font.ColorIndex = 1
    
29.             End If
    
30.         Else
    
31.             Cells(i + 1, 3) = ""
    
32.             Cells(i + 1, 3).Font.ColorIndex = 1
    
33.         End If
    
34.     Next
    
35. End Sub

复制代码

su45

最终代码：

1. Sub 基础表整理()
   
2. On Error Resume Next
   
3.     Dim a, c As Range, Rng As Range, RG As Range
   
4.     Dim Hx As Long, arr, Brr, d As Object, i&
   
5.     With Sheets("产品信息")
   
6.         arr = .Range("a2:b" & .Range("a65536").End(xlUp).Row)
   
7.     End With
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     For i = 1 To UBound(arr)
   
10.         If Not d.exists(arr(i, 1)) Then
    
11.             d(arr(i, 1)) = arr(i, 2)
    
12.         Else
    
13.             d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
    
14.         End If
    
15.     Next i
    
16.     Brr = Sheets("基础表").Range("d2:d" & Sheets("基础表").Range("d65536").End(xlUp).Row)
    
17.     With Columns("C:C")
    
18.         .Validation.Delete
    
19.         .Font.ColorIndex = 1
    
20.     End With
    
21.     For i = 1 To UBound(Brr)
    
22.         If d.exists(Brr(i, 1)) Then
    
23.             If InStr(d(Brr(i, 1)), ",") Then
    
24.                 With Cells(i + 1, 3).Validation
    
25.                     .Add 3, 1, 1, d(Brr(i, 1))
    
26.                 End With
    
27.                 Cells(i + 1, 3) = Split(d(Brr(i, 1)), ",")(0)
    
28.                 Cells(i + 1, 3).Font.ColorIndex = 3
    
29.             Else
    
30.                 Cells(i + 1, 3) = d(Brr(i, 1))
    
31.             End If
    
32.         End If
    
33.     Next
    
34. End Sub

复制代码

如履薄冰_﹌

su45 发表于 2014-9-13 15:00
最终代码：

谢谢，今天车间干活，还没有时间看，我晚上看看，

如履薄冰_﹌

su45 发表于 2014-9-13 15:00
最终代码：

编码对应单个的是对了，如果编码在产品信息里没有，那供应商应该为空，这个还不对，本来为空的，结果里面还有数据。

如履薄冰_﹌

su45 发表于 2014-9-13 15:00
最终代码：

上面那个代码也不对。晕

su45

你没认真试吧？

看附件：

代码修改1.zip (23.85 KB, 下载次数: 2)

2014-9-13 18:24 上传

点击文件名下载附件

如履薄冰_﹌

su45 发表于 2014-9-13 18:24
你没认真试吧？

看附件：

看过附件了，是不对的。之前那个单元格是复选框，后面输一个代码在产品信息里没有的，那么执行的时候单元格就该为空了。

如履薄冰_﹌

su45 发表于 2014-9-13 18:24
你没认真试吧？

看附件：

如果是有两个供应商那么是这样的。