将字符串中特定位置的单一字符删除

6739912

比如字符串 sring1="DDABCDDSCDBACDDSFAFDCSDDD"

要求：字符串前的的D全部删除，中间的D有两个或两个以上连续在一起的，只留一个，未部的有几个删几个
结果：string1="ABCDSCDBACDSFAFDCS"

Dim string1 As String
string1 = "DDABCDDSCDBACDDSFAFDCSDDD"
For j = 1 To Len(string1)
    s1 = Mid(string1, j, 1)
    s2 = Mid(string1, j + 1, 1)
    If s1 = s2 And s1 = "D" Then
       MsgBox s1 & "=" & s2
       s = Replace(string1, "D", "", j + 1, 1)
       MsgBox s
    End If
Next j
End Sub

6739912

有没有更简单的

hopeson2010

1. Sub yy()
   
2.   Dim string1 As String, s As String
   
3.   Dim dic As Object
   
4.      Set dic = CreateObject("vbscript.regexp")
   
5.      string1 = "DDABCDDddddSCDBACDDSFAFDCSd"
   
6.       With dic
   
7.          .Global = True
   
8.          .MultiLine = True
   
9.          .Pattern = "([^[dD]+)(?=[dD])"
   
10.          For Each a In .Execute(string1 & "d")
    
11.             If s = "" Then
    
12.               s = a.Value
    
13.             Else
    
14.               s = s & "D" & a.Value
    
15.             End If
    
16.          Next a
    
17.      End With
    
18. MsgBox s
    
19. End Sub
    

复制代码

⊙⊙小噤○

用正则也是可以
但你这个情况换个思考方式
是不是说把所有DD替换成D，再看看首尾是不是D？
这样想是不是很简单了？

1.     Dim string1 As String
   
2.     string1 = "DDABCDDSCDBACDDSFAFDCSDDD"
   
3.     Dim ts As String
   
4. 
   
5.     Do
   
6.         ts = string1
   
7.         string1 = Replace(string1, "DD", "D")
   
8.     Loop Until ts = string1
   
9. 
   
10.     If Left(string1, 1) = "D" Then string1 = Right(string1, Len(string1) - 1)
    
11.     If Right(string1, 1) = "D" Then string1 = Left(string1, Len(string1) - 1)

复制代码

fxl447098457

Replace也行 do loop until里面不包含两个"DD"就可以了。

红旗雪

Sub 删除()
  Dim s, i&, s1$
  s = "DDABCDDSCDBACDDSFAFDCSDDD"
  s = Split(s, "D")
  For i = 0 To UBound(s)
    If Len(s(i)) Then
      s1 = s1 & s(i) & "D"
    End If
  Next
  s1 = Left(s1, Len(s1) - 1)
End Sub

6739912

⊙⊙小噤○ 发表于 2018-9-2 09:02
用正则也是可以
但你这个情况换个思考方式
是不是说把所有DD替换成D，再看看首尾是不是D？

这个方法不错

6739912

红旗雪 发表于 2018-9-2 09:10
Sub 删除()
  Dim s, i&, s1$
  s = "DDABCDDSCDBACDDSFAFDCSDDD"

这个更简单

小花鹿

Sub test()
Dim s
s = "DDABCDDSCDBACDDSFAFDCSDDD"
s = Replace(s, "D", " ")
s = Application.Trim(s)
s = Replace(s, " ", "D")
MsgBox s
End Sub

duquancai

6739912 发表于 2018-9-2 09:21
这个更简单

一个split和一个join  就行了！！！

1. Sub main()
   
2.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
3.     js.Language = "JavaScript"
   
4.     MsgBox js.eval("'DDABCDDSCDBACDDSFAFDCSDDD'.split(/D+/).join('D');")
   
5. End Sub

复制代码