VBA修改

yuhjkl

三个一样的VBA能不能改成用一个就行
sub test1()
    On Error Resume Next
    Set d = CreateObject("scripting.dictionary")
    For Each RN In Range("W2:AL501")
        If Not d.exists(RN.Value) Then
            d.Add RN.Value, 1
        Else
            d(RN.Value) = d(RN.Value) + 1
        End If
    Next
    k = d.keys
    s = d.Items
    ReDim arr(1 To UBound(s) + 1)
    For i = 0 To UBound(s)
        If s(i) = 1 Or s(i) = 15 Or s(i) = 16 Then
            t = t + 1
            arr(t) = k(i) * 1
        End If
    Next
    ReDim m(1 To t)
    For i = 1 To t
        m(i) = Format(Application.Small(arr, i), "000")
    Next i
    Range("L1000").End(xlUp).Offset(1, 0).Resize(t, 1) = Application.Transpose(m)
End sub

sub test2()
    On Error Resume Next
    Set d = CreateObject("scripting.dictionary")
    For Each RN In Range("W3:AL502")
        If Not d.exists(RN.Value) Then
            d.Add RN.Value, 1
        Else
            d(RN.Value) = d(RN.Value) + 1
        End If
    Next
    k = d.keys
    s = d.Items
    ReDim arr(1 To UBound(s) + 1)
    For i = 0 To UBound(s)
        If s(i) = 1 Or s(i) = 15 Or s(i) = 16 Then
            t = t + 1
            arr(t) = k(i) * 1
        End If
    Next
    ReDim m(1 To t)
    For i = 1 To t
        m(i) = Format(Application.Small(arr, i), "000")
    Next i
    Range("L1000").End(xlUp).Offset(1, 0).Resize(t, 1) = Application.Transpose(m)
End sub

sub test3()
    On Error Resume Next
    Set d = CreateObject("scripting.dictionary")
    For Each RN In Range("W4:AL503")
        If Not d.exists(RN.Value) Then
            d.Add RN.Value, 1
        Else
            d(RN.Value) = d(RN.Value) + 1
        End If
    Next
    k = d.keys
    s = d.Items
    ReDim arr(1 To UBound(s) + 1)
    For i = 0 To UBound(s)
        If s(i) = 1 Or s(i) = 15 Or s(i) = 16 Then
            t = t + 1
            arr(t) = k(i) * 1
        End If
    Next
    ReDim m(1 To t)
    For i = 1 To t
        m(i) = Format(Application.Small(arr, i), "000")
    Next i
    Range("L1000").End(xlUp).Offset(1, 0).Resize(t, 1) = Application.Transpose(m)
End sub

yuhjkl

哪位能岀出手