字典拆分数据结果有出入！

SLF19860429

以下代码是在网络上学习看到的，请问老师们为什么第二个使用一个字典方法时代码运行的结果跟第一个不一样?需要怎么改进才能一样？
代码一：

Sub caifen()

Dim Myr&, Arr, x&

Dim d, d1, d2, i&, j&

Set d = CreateObject("Scripting.Dictionary")

Set d1 = CreateObject("Scripting.Dictionary")

Set d2 = CreateObject("Scripting.Dictionary")

Myr = [a65536].End(xlUp).Row

Arr = Range("a2:a" & Myr)

Range("c2:e" & Myr).ClearContents

my = Array("MOTO", "诺基亚", "三星", "索爱")

gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派")

For x = 1 To UBound(Arr)

    For i = 0 To UBound(my)

        If InStr(Arr(x, 1), my(i)) > 0 Then

            d(Arr(x, 1)) = ""

            GoTo 100

        End If

    Next i

    For j = 0 To UBound(gc)

        If InStr(Arr(x, 1), gc(j)) > 0 Then

            d1(Arr(x, 1)) = ""

            GoTo 100

        End If

    Next j

    d2(Arr(x, 1)) = ""

100:

Next x

Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)

Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)

Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)

End Sub

代码二：

Sub 拆分()

    Dim pp1$, pp2$, nRow%, ds, Brr(), s(1 To 3) As Integer

    Set ds = CreateObject("scripting.dictionary")

    pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), Range("g1").End(xlDown))), ",")

    pp2 = Join(WorksheetFunction.Transpose(Range(Range("h2"), Range("h1").End(xlDown))), ",")

    nRow = Range("a1").End(xlDown).Row

    Arr = Range("a1:a" & nRow)

    ReDim Brr(1 To nRow, 1 To 3)

    For i = 2 To nRow

        If Not ds.Exists(Arr(i, 1)) Then

            ds(Arr(i, 1)) = ""

            If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then

                s(1) = s(1) + 1

                Brr(s(1), 1) = Arr(i, 1)

            ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then

                s(2) = s(2) + 1

                Brr(s(2), 2) = Arr(i, 1)

            Else

                s(3) = s(3) + 1

                Brr(s(3), 3) = Arr(i, 1)

            End If

        End If

    Next

    Range("c2:e" & nRow) = Brr

End Sub

lsc900707

第二个代码拆分的依据你没填写！

jiminyanyan

看兰老师的帖子把。。。

iwangyi

第一个蓝版，第二个山版，原版没问题，从自己找原因。

chaohuahch

请看下面两张图里面，标注的差异内容。

SLF19860429

lsc900707 发表于 2018-8-17 17:45
第二个代码拆分的依据你没填写！

谢谢老师，原来是这里出问题了

SLF19860429

iwangyi 发表于 2018-8-17 19:02
第一个蓝版，第二个山版，原版没问题，从自己找原因。

现在弄明白了，刚开始接触VBA。请见谅

SLF19860429

chaohuahch 发表于 2018-8-17 19:09
请看下面两张图里面，标注的差异内容。

看懂了，谢谢