[已解决]竖排变横排有个空值，怎么忽略？？？？

张雄友

竖排变横排有个空值，怎么忽略？？？？

最佳答案

月排行榜 / 总排行榜

爱疯

2014-11-28 20:04

Sub 逐一引用()
    Application.ScreenUpdating = False
    Range("E4:Z65536").ClearContents
    Dim arr, dic As Object, i&, j&, kk, tt
    Set dic = CreateObject("scripting.dictionary")    '
    arr = Range("A2:B" & Range("B65536").End(3).Row)
    ReDim brr(1 To UBound(arr), 0 To 50)

    For i = 1 To UBound(arr)
        If Len(arr(i, 2)) Then
            If Len(arr(i, 1)) Then
                dic(arr(i, 1)) = dic(arr(i, 1)) & "," & arr(i, 2)
                w = arr(i, 1)
            Else
                dic(w) = dic(w) & "," & arr(i, 2)
            End If
        End If
    Next
    kk = dic.keys: tt = dic.Items
    For j = 0 To UBound(kk)
        ee = Split(tt(j), ",")
        For k = 0 To UBound(ee)
            brr(j + 1, k) = ee(k)
        Next
        brr(j + 1, 0) = kk(j)
    Next
    [E4].Resize(UBound(kk) + 1, 50) = brr
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

爱疯

Sub 逐一引用()
    Application.ScreenUpdating = False
    Range("E4:Z65536").ClearContents
    Dim arr, dic As Object, i&, j&, kk, tt
    Set dic = CreateObject("scripting.dictionary")    '
    arr = Range("A2:B" & Range("B65536").End(3).Row)
    ReDim brr(1 To UBound(arr), 0 To 50)

    For i = 1 To UBound(arr)
        If Len(arr(i, 2)) Then
            If Len(arr(i, 1)) Then
                dic(arr(i, 1)) = dic(arr(i, 1)) & "," & arr(i, 2)
                w = arr(i, 1)
            Else
                dic(w) = dic(w) & "," & arr(i, 2)
            End If
        End If
    Next
    kk = dic.keys: tt = dic.Items
    For j = 0 To UBound(kk)
        ee = Split(tt(j), ",")
        For k = 0 To UBound(ee)
            brr(j + 1, k) = ee(k)
        Next
        brr(j + 1, 0) = kk(j)
    Next
    [E4].Resize(UBound(kk) + 1, 50) = brr
    Application.ScreenUpdating = True
End Sub

张雄友

爱疯 发表于 2014-11-28 20:04
Sub 逐一引用()
    Application.ScreenUpdating = False
    Range("E4:Z65536").ClearContents

If Len(arr(i, 2)) Then
            If Len(arr(i, 1)) Then

这二句代码交换位置就会出错，痛定思痛，不得其解？？？？？？？？？？？？？？？？

爱疯

        '第i行的B列是非空吗？
        If Len(arr(i, 2)) Then
            '是，第i行的A列是非空吗？
            If Len(arr(i, 1)) Then
                '是，用字典关键字arr(i, 1)的值，累加一个文本内容arr(i,2)
                dic(arr(i, 1)) = dic(arr(i, 1)) & "," & arr(i, 2)
                '因为接下来的空单元格也对应该关键字arr(i,1)，所以临时用w保存下
                w = arr(i, 1)
            Else
                '不是，用w也就是上次保存的关键字arr(i,1)，继续累加文本
                dic(w) = dic(w) & "," & arr(i, 2)
            End If
        End If


因为这两个条件，是不等价的。
如果你换了，那么必然和未换时的效果不同。