[已解决]为什么K列，K40不添加F列数据？？？正确结果如M40。

fangniuji

Option Explicit

Sub test()
Dim a, i, arr, isflag, diction
isflag = False
Set diction = CreateObject("scripting.dictionary")
a = Cells(200000, 2).End(xlUp).Row
arr = Cells(1, 2).Resize(a, 7)
For i = 1 To a
diction(Replace(arr(i, 1), "0", "")) = arr(i, 7)
Next i
Erase arr
a = Cells(200000, 1).End(xlUp).Row
arr = Cells(1, 1).Resize(a)
For i = 1 To a
If arr(i, 1) = "%" Then isflag = True
If isflag Then
If diction.exists(arr(i, 1)) Then
If diction(arr(i, 1)) <> "" Then arr(i, 1) = arr(i, 1) & [h1] & diction(arr(i, 1))
End If
End If
Next i
[k1].Resize(a) = arr
End Sub

这个数据源

为什么K列，K40不添加F列数据？？？正确结果如M40。帮我改一下，谢谢！！！

最佳答案

月排行榜 / 总排行榜

zjdh

2013-5-30 14:14

Sub test()
    Dim a, i, arr, isflag, diction
    isflag = False
    Set diction = CreateObject("scripting.dictionary")
    a = Cells(200000, 2).End(xlUp).Row - 2
    arr = Cells(3, 2).Resize(a, 7)
    For i = 1 To a
        If arr(i, 1) = "" Then Exit For   
        diction("T" & Val(Split(arr(i, 1), "T")(1))) = arr(i, 7)
    Next i
    Erase arr
    a = Cells(200000, 1).End(xlUp).Row
    arr = Cells(1, 1).Resize(a)
    For i = 1 To a
        If arr(i, 1) = "%" Then isflag = True
        If isflag Then
            If diction.exists(arr(i, 1)) Then
                If diction(arr(i, 1)) <> "" Then arr(i, 1) = arr(i, 1) & [h1] & diction(arr(i, 1))
            End If
        End If
    Next i
    [k1].Resize(a) = arr
End Sub

跳转到最佳答案楼层

zjdh

Sub test()
    Dim a, i, arr, isflag, diction
    isflag = False
    Set diction = CreateObject("scripting.dictionary")
    a = Cells(200000, 2).End(xlUp).Row - 2
    arr = Cells(3, 2).Resize(a, 7)
    For i = 1 To a
        If arr(i, 1) = "" Then Exit For   
        diction("T" & Val(Split(arr(i, 1), "T")(1))) = arr(i, 7)
    Next i
    Erase arr
    a = Cells(200000, 1).End(xlUp).Row
    arr = Cells(1, 1).Resize(a)
    For i = 1 To a
        If arr(i, 1) = "%" Then isflag = True
        If isflag Then
            If diction.exists(arr(i, 1)) Then
                If diction(arr(i, 1)) <> "" Then arr(i, 1) = arr(i, 1) & [h1] & diction(arr(i, 1))
            End If
        End If
    Next i
    [k1].Resize(a) = arr
End Sub