求问vba将同一工作簿不同工作表的同一列,通过字典去重后合并为一个数组的方法

我自己已经编了一部分,由于vba不熟悉,很难解决,请vba高手指导.
现在在做一个模糊搜索的窗体,需要用到数据是: 表格Q1,Q2,Q3,Q4,Q5,Q6第2列的数据通过字典去重复后合并后的一个数组.

单个工作表的单列数据字典去重网上很多,但多个工作表的列去重后合并我试过用一维和二维数组进行合并都说类型不匹配,请高手帮忙解决.
可以解决的追加奖励,以表小小心意,谢谢!!

下面是我编写的一些代码...
Sub 数据test()
Dim d As Object, i&
Set d = CreateObject("scripting.dictionary")
Dim arrall, arr1, arr2, arr3, arr4, arr5, arr6, arra
Set Q1 = Sheets("铸件CASTING")
Set Q2 = Sheets("机加配件")
Set Q3 = Sheets("管件&外协配件")
Set Q4 = Sheets("塑料件&标准件")
Set Q5 = Sheets("进口件")
Set Q6 = Sheets("包装物")
For i = 2 To Q1.[B65536].End(3).Row '我想把上面几个表的B列都合并到一个数组.
If Q1.Cells(i, 2) <> "" Then
aa = Q1.Cells(i, 2) & "|" & Q1.Cells(i, 5)
d(aa) = ""
End If
Next
arra = d.keys '赋值为一维数组

Dim arrtest1, arrtest2

For X = 0 To UBound(arr)
ss = Split(arra(X), "|")
'Sheets("Sheet1").Cells(X + 1, "a") = ss(0)'我不要放到单元格而是数值所以这行不要
arrtest1(X) = ss(0) '出错,类型不匹配
'Sheets("Sheet1").Cells(X + 1, "b") = ss(1)'我不要放到单元格而是数值所以这行不要
arrtest2(X) = ss(1) '出错,类型不匹配
Next

Set d = Nothing
'由于上面的都出错,下面都不会写了...最终是想把Q1-Q5的去重复的第二列的值放到arrtest1数组,对应的第五列放到arrtest2数组里面....
End Sub

Sub 数据test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim  arr1(1 to 6), arr2,arrtest1(),arrtest2()
Set arr(1)= Sheets("铸件CASTING")
Set arr(2)= Sheets("机加配件")
Set arr(3)= Sheets("管件&外协配件")
Set arr(4)= Sheets("塑料件&标准件")
Set arr(5)= Sheets("进口件")
Set arr(6)= Sheets("包装物")
For i = 1 To 6
    with arr(i)
        for k=2 to .[B65536].End(3).Row  '我想把上面几个表的B列都合并到一个数组.
            If .Cells(i, 2) <> "" Then
                aa = .Cells(i, 2) & "|" & .Cells(i, 5)  
                d(aa) = ""
            End If
        Next
    end with
next
arr2 = d.keys '赋值为一维数组
redim arrtest1(0 to ubound(arr2))
redim arrtest2(0 to ubound(arr2))
for i=0 to ubound(arr2)
    arrtest1(i)=split(arr2(i),"|")(0)
    arrtest2(i)=split(arr2(i),"|")(1)
next
Set d = Nothing
End Sub

大概是这样~

追问

试了下,除了部分定义错了之外,改正定义后,检查了数组里面只有几个数据,可能是哪里有出错了.
但还是十分感谢您!!!

温馨提示:答案为网友推荐,仅供参考
第1个回答  2014-05-06
Sub 数据test()
Dim d As Object, i, st, sName, aa

Set d = CreateObject("scripting.dictionary")
For Each sName In Array("铸件CASTING", "机加配件", "管件&外协配件", "塑料件&标准件", "进口件", "包装物")
Set st = Sheets(sName)
For i = 2 To st.[B65536].End(3).Row
If st.Cells(i, 2) <> "" Then
aa = st.Cells(i, 2) & "|" & st.Cells(i, 5)
d(aa) = True
End If
Next i
Next sName

Dim arrtest1(), arrtest2(), ss() As String
i = d.Count
ReDim arrtest1(i), arrtest2(i)
i = 1
For Each sName In d.keys
ss = Split(sName, "|")
arrtest1(i) = ss(0)
arrtest2(i) = ss(1)
i = i + 1
Next sName

Set d = Nothing

End Sub追问

很厉害,高手!!
请问为什么 我自己编写的给赋值就不行呢?
还有能否有联系方法什么可以私下m我吗? 简单的我都是自己上网搜去学习,但有时太难的东西不懂希望可以请教你

追答

如果有疑问,请粘贴有疑问的语句。

追问

arrtest1(X) = ss(0) '出错,类型不匹配 这个是我自己编写的,总提示错误,请问这个是哪里有问题,分出来的ss(0) 和ss(1)不是数组类型吗?

追答

arrtest1的大小你没有定义,需要redim

追问

请回答,我重新给分你..十分抱歉..

相关了解……

你可能感兴趣的内容

本站内容来自于网友发表,不代表本站立场,仅表示其个人看法,不对其真实性、正确性、有效性作任何的担保
相关事宜请发邮件给我们
© 非常风气网