[已解决]加急！求助字典exists方法的使用，谢谢大虾

David_文奇 · 发表于 2014-2-20 14:07

本人菜鸟一枚，写了一段很菜的代码

现在遇到问题：我创建了两个字典，然后分别取了两个表中符合条件的值，然后比较两个字典的重复值，在第一个字典中删除重复值。但始终无法成功。

先贴代码，具体内容见附件：

' 建立两个字典获取不同的数据，删除dicA中和dicB重复的值
Sub 测试()
Sheets(3).Cells.Clear
Workbooks("求助字典exists方法的使用.xlsm").Worksheets("经纪人提成明细").Activate
If ActiveSheet.Name Like "*经纪人提成明细*" Then
Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
'获取【经纪人明细表】公共列表
For i = 3 To [L65536].End(3).Row
zh = Cells(i, "K").Value
If Not dicA.exists(zh) And zh Like "*公共*" And zh <> "" Then
dicA.Add zh, ""
End If
Next
'获取【营业部提成表】公共列表
For j = 8 To 2564
Set cel2 = Worksheets("营业部提成表").Cells(j, "H")
If Not dicB.exists(cel2) And cel2 Like "*公共*" And cel2 <> "" Then
dicB.Add cel2, ""
End If
Next
arr1 = dicA.keys
For b = 0 To dicA.Count - 1
If dicB.exists(arr1(b)) Then
dicA.Remove (arr1(b))
Debug.Print "删除: " & arr1(b)
End If
Next
'将删除值后的dicA的值赋给sheet3的a1单元格
arr1 = Application.Transpose(dicA.keys)
Sheets(3).[A1].Resize(UBound(arr1), 1) = arr1
'释放字典
Set dicA = Nothing
Set dicB = Nothing
Sheets(3).Select
Else
MsgBox "请在经纪人提成明细操作"
End If
End Sub

复制代码

拜托版主帮我解决问题啊谢谢了

最佳答案

月排行榜 / 总排行榜

eaglexs

2014-2-21 08:59

Sub 提取不重复值()
Dim Dic As Object, i%, Arr, Brr, Crr
Set Dic = CreateObject("scripting.dictionary")
With Sheets("经纪人提成明细") '把数据读入数组，加快操作速度
Arr = .Range("l3", .Cells(Rows.Count, "l").End(3)).Value
End With
For i = 1 To UBound(Arr)
If Arr(i, 1) Like "*公共*" Then '实际数据源中没有空单元格，不用判断是否为空
Dic(Arr(i, 1)) = "" '自动覆盖重复记录
End If
Next
With Sheets("营业部提成表")
Brr = .Range("h8", .Cells(Rows.Count, "h").End(3)).Value
End With
For i = 1 To UBound(Brr)
If Dic.exists(Brr(i, 1)) Then
Dic.Remove (Brr(i, 1))
End If
Next
Crr = Dic.keys
Sheets("sheet3").Range("a1").Resize(UBound(Crr) + 1) = WorksheetFunction.Transpose(Crr)
End Sub

复制代码

跳转到最佳答案楼层

David_文奇 · 发表于 2014-2-20 14:21

新人真心不容易啊，求带教，求顶贴

David_文奇 · 发表于 2014-2-20 14:36

兰版，其他高手们，帮我看看吧。人气太低了，只有自己来顶了！

苗凱 · 发表于 2014-2-20 14:57

If dicB.exists(arr1(b)) Then
dicA.Remove (arr1(b)) 这句有问题？

David_文奇 · 发表于 2014-2-20 15:09

苗凱发表于 2014-2-20 14:57
If dicB.exists(arr1(b)) Then
dicA.Remove (arr1(b)) 这句有问题？
...

问题在哪儿呢？我就是没有找出来问题所在。感谢回答，好的开端！

David_文奇 · 发表于 2014-2-20 15:17

我是把dicA的值赋给arr1，然后判断是否在dicB中存在，若存在，就在dicA中进行删除。

苗凱 · 发表于 2014-2-20 15:26

Set d = CreateObject("Scripting.Dictionary")
With Sheets("sheet1")
ashrow = .Range("A" & Rows.Count).End(xlUp).Row
bshrow = .Range("B" & Rows.Count).End(xlUp).Row
arra = .Range("A2:A" & ashrow)
arrb = .Range("b2:b" & bshrow)
For i = 1 To UBound(arra)
   d(arra(i, 1)) = ""
   n = n + 1
   ReDim Preserve arra1(1 To 1, 1 To n)
   arra1(1, n) = arra(i, 1)
Next i
For i = 1 To UBound(arrb)
   If d.exists(arrb(i, 1)) = False Then
      n = n + 1
      ReDim Preserve arra1(1 To 1, 1 To n)
      arra1(1, n) = arrb(i, 1)
Else
      m = m + 1
      ReDim Preserve arrb1(1 To 1, 1 To m)
      arrb1(1, m) = arrb(i, 1)
   End If
Next i
.Range("D2").Resize(n) = Application.Transpose(arra1)
.Range("E2").Resize(m) = Application.Transpose(arrb1)
End With
End Sub

David_文奇 · 发表于 2014-2-20 15:36

苗凱发表于 2014-2-20 15:26
Set d = CreateObject("Scripting.Dictionary")
With Sheets("sheet1")
ashrow = .Range("A" & Rows.Coun ...

怎么看起来有点吃力啊。和我之前写的差别太大，能帮我解析下我的代码有什么问题吗？

David_文奇 · 发表于 2014-2-20 16:04

求解析，求帮助啊！

David_文奇 · 发表于 2014-2-20 16:09

求解析，求帮助啊！

		自动登录	找回密码
密码			注册