佛山小老鼠带您走进VBA数组(菜鸟请进)

bridgeyao

支持小老鼠！

lpclimber

感谢楼主的无私奉献，受教了！！

he_zai

这个！！好～～……………………

weiyingde

留个脚印，以后慢慢啃啃，慢慢学习！！向老鼠老师致敬！！！

lclylj

小人学识浅薄，假装回答一下第一个  
Sub test()
    Call 自己
End Sub
Sub 自己()
    Msbgox "亲:您好!", 64, "问候"
End Sub
MsgBox 拼写错误。。

kylin_studio

感谢分享，mark，有空学习一下

MRHUANGHESIR

找出两列相同项与不相同项及两列共有，直接用字典就行了吧

三流高手

占位学习了，感谢老师的辛勤劳动

puppet′要自由

感谢楼主分享，对新手很有用。

佛山小老鼠

MRHUANGHESIR 发表于 2015-2-4 18:43
找出两列相同项与不相同项及两列共有，直接用字典就行了吧

Option Explicit
Sub 两列异同项()
    Dim DicA, DicB, DicC, arrA, arrB, x&, y&, k&, a&, b&, arr1, arr2
    Dim AyesBno(1 To 100, 1 To 1), AyesByes(1 To 100, 1 To 1), AnoByes(1 To 100, 1 To 1)
    Dim i&, ii&, iii&, j&
    Set DicA = CreateObject("Scripting.Dictionary")
    Set DicB = CreateObject("Scripting.Dictionary")
    Set DicC = CreateObject("Scripting.Dictionary")
    a = Cells(Rows.Count, 1).End(xlUp).Row
    b = Cells(Rows.Count, 2).End(xlUp).Row
    arrA = Range("A1:A" & a)
    arrB = Range("B1:B" & b)
    For x = 1 To UBound(arrA)
        If Not DicA.exists(arrA(x, 1)) Then
            DicA(arrA(x, 1)) = ""
            DicC(arrA(x, 1)) = ""
        End If
    Next x
    For y = 1 To UBound(arrB)
        If Not DicB.exists(arrB(y, 1)) Then
            DicB(arrB(y, 1)) = ""
            DicC(arrB(y, 1)) = "" '这时的字典dicC是A列和B列去重之后的,也就是A列B列的唯一值
        End If
    Next y
    arr1 = DicA.keys 'arr1,arr2都是一维,且它们的编号都是从0开始
    arr2 = DicB.keys
    '把字典dicA里的关键词,装入字典dicB里,如果没有报错方法,说明A列有,B列没有，如果报错话，说明这个关键词
    '是A列B列共有的
    '================================================
    On Error Resume Next '有错误让代码继续运行
    For j = 0 To DicA.Count - 1
        DicB.Add arr1(j), ""
        If Err.Number = 0 Then
            '说明A列有,B列没有
            i = i + 1
            AyesBno(i, 1) = arr1(j)
        Else
            '如果错误值err<>0,那么说明A列B共用
            ii = ii + 1
            AyesByes(ii, 1) = arr1(j)
        End If
        Err = 0
    Next j
    '==========================================
    For k = 0 To DicB.Count - 1
        DicA.Add arr2(k), ""
        If Err.Number = 0 Then
            iii = iii + 1
            AnoByes(iii, 1) = arr2(k)
        End If
        Err = 0
    Next k
    [D1] = "A列B列唯一值"
    [D2].Resize(DicC.Count, 1) = Application.Transpose(DicC.keys)
    [E1] = "A列B列共用的"
    [E2].Resize(ii, 1) = AyesByes
    [F1] = "A列有B列没有的"
    [F2].Resize(i, 1) = AyesBno
    [G1] = "A列没有B列有"
    [G2].Resize(iii, 1) = AnoByes
    Range("D1:G1").EntireColumn.AutoFit
End Sub
Sub 清空()
   [D:G].ClearContents
End Sub