<em>excel</em> <em>vba</em>按内容移动数据到对

Sub xx()
    Dim b(1 To 10, 1 To 2) As Integer
    a = [k18:t27]
    [k18:t27].ClearContents
    For i = 1 To 10
        b(i, 1) = i
        For j = 1 To 10
            If a(j, i) <> "" Then b(i, 2) = b(i, 2) + 1: c = c + 1
        Next
    Next
    For i = 1 To 9
        For j = 9 To i Step -1
            If b(b(j, 1), 2) < b(b(j + 1, 1), 2) Then
                t = b(j, 1)
                b(j, 1) = b(j + 1, 1)
                b(j + 1, 1) = t
            End If
        Next
    Next
    For i = 1 To 10
        For j = 1 To b(b(i, 1), 2)
            [k18,t27].Cells(j, i) = a(j, b(i, 1))
        Next
    Next
    [o28] = c & "个e799bee5baa6e79fa5e98193e58685e5aeb9339"
End Sub

Sub s()
    Dim brr(1 To 10)
    c = 1
    For i = 39 To 1038
        arr = Cells(i, 1).Resize(, 10)
        Cells(i, 1).Resize(, 10).ClearContents
        For j = 1 To 10
            If arr(1, j) <> "" Then Cells(i, Val(Mid(arr(1, j), c, 1)) + 1) = arr(1, j)
        Next
    Next
End Sub

sub s()
    arr=[b5:g100]
    [b5:g100]=""
    [c5:h100]=arr
end sub

代码设定范百围：B5:D25区域度。【自己根据问实际情答况修内改】

Sub 删除空单元容格()
    For Each rng In Range("B5:d25")
        If rng = "" Then rng.Delete Shift:=xlUp
    Next
End Sub