CODEWITHSUNDEEP
excelvbadatatabledata-cleaning
danny
danny

Reputation: 67

Clear text of specific characters in a celll with VBA

I'm looking for some help please with some VBA.

I have the next table

header1
000Model Test0Model Val00User0
Perman000User0Model Name000000
000Perman00000000000000000000Name

So I need to replace all Ceros with only one "," like this

header1
,Model Test,Model Val,User,
Perman,User,Model Name,
,Perman,Name

Is there a combination of formulas to do this? or with code in VBA?

Upvotes: 0

Views: 225

Answers (3)

FaneDuru
FaneDuru

Reputation: 42236

Please, try the next function:

Function replace0(x As String) As String
    Dim matches As Object, mch As Object, arr, k As Long
    ReDim arr(Len(x))
     With CreateObject("VbScript.regexp")
        Pattern = "[0]{1,30}"
        .Global = True
        If .test(x) Then
            replace0 = .replace(x, ",")
        End If
     End With
End Function

It can be tested using:

Sub replaceAllzeroByComma()
   Dim x As String
   x = "000Perman00000000000000000000Name"
   'x = "000Model Test0Model Val00User0"
   'x = "Perman000User0Model Name000000"
   Debug.Print replace0(x)
End Sub

Uncheck the checked lines, one at a time and see the result in Immediate Window (Ctrl + G, being in VBE)

Upvotes: 4

T.M.
T.M.

Reputation: 9948

Another option would be to check a character array as follows:

  • a) atomize input string to a tmp array of single characters via String2Arr()
  • b) check for zero characters in tmp via CheckChar
  • c) execute a negative filtering preserving first zeros in each 0-sequence via Filter(tmp, delChar, False)
  • d) return joined string
Function Rep0(ByVal s As String, Optional delChar As String = "0")
'Purp.: replace first zero in each 0-sequence by ",", delete any remaining zeros
    Dim tmp: tmp = String2Arr(s)        ' a) atomize string to character array
    Dim i As Long
    For i = LBound(tmp) To UBound(tmp)  ' b) check zero characters
        Dim old As String: CheckChar tmp, i, old, delChar
    Next
    tmp = Filter(tmp, delChar, False)   ' c) negative filtering preserving non-deletes
    Rep0 = Join(tmp, vbNullString)      ' d) return cleared string
End Function

Help procedures

Sub CheckChar(ByRef arr, ByRef i As Long, ByRef old As String, _
              ByVal delChar As String, Optional replChar As String = ",")
'Purp.: replace 1st delChar "0" in array (depending on old predecessor)
        If Left(arr(i), 1) = delChar Then   ' omit possible string end character
            If Not old Like "[" & delChar & replChar & "]" Then arr(i) = replChar
        End If
        old = arr(i)                        ' remember prior character
End Sub

Function String2Arr(ByVal s As String)
'Purp.: atomize input string to single characters array
    s = StrConv(s, vbUnicode)
    String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

Upvotes: 1

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60174

If you have Microsoft 365, you can use:

=IF(LEFT(A1)="0",",","")&TEXTJOIN(",",TRUE,TEXTSPLIT(A1,"0"))&IF(RIGHT(A1)="0",",","")
  • Split on the zero's
  • Join the split text with a comma delimiter
  • Have to specially test first character
  • and also the last character as pointed out by @T.M.

enter image description here

Upvotes: 2

Related Questions