[已解决]如何实现批量更改

fengdavid

jxncfxsf 发表于 2013-4-9 21:46
我也弄了一下，看好用不。

也好用，谢谢帮助！

fengdavid

今天真是人品大爆发啊，呵呵！

1032446692

zjdh 发表于 2013-4-9 21:03
是每一个单元为一组数，出现重复则全部修改，楼主的示例就是这个意思。

原来是这种意思   还是你了解楼主

1032446692

Sub test()
    Dim arra, arrb, a, d
    a = Cells(60000, 1).End(xlUp).Row
    arra = Cells(1, 1).Resize(a)
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To a
        arrb = VBA.Split(arra(i, 1), "-")
        arra(i, 1) = ""
        For j = 0 To UBound(arrb)
            d(arrb(j)) = d(arrb(j)) + 1
            If d(arrb(j)) > 1 Then
                arra(i, 1) = arra(i, 1) & arrb(j) & "." & d(arrb(j)) - 1 & "-"
            Else
                arra(i, 1) = arra(i, 1) & arrb(j) & "-"
            End If
        Next j
        Erase arrb
        arra(i, 1) = Left(arra(i, 1), Len(arra(i, 1)) - 1)
    Next i
    Cells(1, 4).Resize(a) = arra
End Sub

这是我写的  你也可以借鉴一下

fengdavid

1032446692 发表于 2013-4-9 22:45
Sub test()
    Dim arra, arrb, a, d
    a = Cells(60000, 1).End(xlUp).Row

谢谢你，今天竟然等到这么多人的帮助