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
精彩评论