开发者

Removing consecutive duplicate values from CSV in Excel Visual Basic

In an Excel 2007 VB Macro, I'm trying to do is take a comma separate String, split it, and then reduce it, removing duplicate consecutive values. So "2,2,2,1,1" would become "2,1", or "3,3,3,2,3,3,3" would become "3,2,3".

It looks like it should work, but when it gets to the "If currentVal.equals(prevVal) = False Then", it his a runtime error 424, 'Object required'.

It's been forever since I did any VB, and that was VP6.

Sheets("Sheet1").Select
Range("I1").Select

Dim data() As String
Dim currentVal, prevVal As String
Dim output As String
Dim temp As Boolean

Do Until Selection.Value = ""
        data = Split(Selection, ",")
        output = ""
        prevVal = ""
        For Each elem In data
            currentVal = CStr(elem)
            If currentVal.equals(prevVal) = False Then
            output = output + elem + ","
            End If
        Ne开发者_如何学运维xt elem
        Selection.Value = output
        Selection.Offset(1, 0).Select
Loop


There's a few problems. First, you can't use:

Dim currentVal, prevVal As String

You must use:

Dim currentVal as String
Dim prevVal As String

or:

Dim currentVal as String, prevVal as String

...as you can't shortcut types in VBA unfortunately. Secondly, strings aren't objects in VBA so there's no .equals (or any other method). You want:

If currentVal <> prevVal Then

Lastly, you need to set prevVal at the end of your loop or your code won't work as expected.

EDIT Here's some working code:

Dim data() As String
Dim currentVal As String, prevVal As String
Dim output As String
Dim temp As Boolean

Do Until Selection.Value = ""
        data = Split(Selection, ",")
        output = ""
        prevVal = ""
        For Each elem In data
            currentVal = CStr(elem)
            If currentVal <> prevVal Then
                output = output + elem + ","
            End If
            prevVal = currentVal
        Next elem
        Selection.Value = output
        Selection.Offset(1, 0).Select
Loop


I’d suggest using a variant array with a regular expression to maximise the efficiency and speed of your approach. Something like this

Update: Picking up on my own advice elsewhere the code now test for more than 1 cell before applying the variant array

   Sub Clear()
    Dim ws As Worksheet
    Dim rng1 As Range
    Dim X
    Dim lngRow As Long
    Dim objRegex
    Set objRegex = CreateObject("vbscript.regexp")
    Set ws = Sheets("Sheet1")
    Set rng1 = ws.Range(ws.[i1], ws.Cells(Rows.Count, "I").End(xlUp))
    With objRegex
        .Global = True
        .Pattern = "(\d)(,(\1))+"
        If rng1.Cells.Count > 1 Then
            X = rng1
            For lngRow = 1 To UBound(X)
                X(lngRow, 1) = .Replace(X(lngRow, 1), "$1")
            Next lngRow
            rng1 = X
        Else
            rng1.Value = .Replace(rng1.Value, "$1")
        End If
    End With
End Sub


You could use a dictionary object especially since you are moving the numbers to a text file it doesn't matter that they are not treated as numbers per se. See this question

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜