Sub RemoveConsecutive()

Dim lastRowA As Integer Dim lastRowB As Integer Dim lastRowC As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim strA As String Dim strB As String Dim strC As String

lastRowA = Range('A' & Rows.Count).End(xlUp).Row lastRowB = Range('B' & Rows.Count).End(xlUp).Row lastRowC = 1

For i = 1 To lastRowA strA = Range('A' & i).Value strC = '' For j = 1 To lastRowB strB = Range('B' & j).Value If InStr(strA, strB) > 0 Then strA = Replace(strA, strB, '') End If Next j If strA <> '' Then For k = 1 To Len(strA) If Mid(strA, k, 1) = Mid(strA, k + 1, 1) Then strC = strC & Mid(strA, k, 1) Else strC = strC & Mid(strA, k, 1) & ' ' End If Next k Range('C' & lastRowC).Value = strC lastRowC = lastRowC + 1 End If Next i

End Sub


原文地址: https://www.cveoy.top/t/topic/mJQf 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录