☰

Excel VBA 宏用于删除特定的重复字符，并且每次在字符串中找到该字符时都会保留一个实例

tag-icon • tag-icon microsoft-excel vba macros
Excel VBA 宏用于删除特定的重复字符，并且每次在字符串中找到该字符时都会保留一个实例

Windows 10 Microsoft Excel 2019

我有一个 Excel 工作表，其中 A 列的每个单元格中有多个字符串

字符串格式如下：

Some Text;;;;;;More text;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Even more text;;;;;;;;;;;;;;Yet More;;And more text;;;;;;;;;;;;;;;;;;;;;;;And More

我需要能够删除重复项;，并且在每个出现重复项的地方只留下一个实例，如下所示：

Some Text;More text;Even more text;Yet More;And more text;And More

这需要是我在需要时可以重复的事情，所以我认为宏或 VBA 是最好的。

我无法在 Excel 中找到可以执行此操作并仅留下“；”字符的一个实例的方法。

在 VBA 中，我可以使用以下方法删除所有重复的字符

Public Sub RemoveDupeChars2()
  Dim cell As Range
  For Each cell In Application.Selection
    cell.Value = RemoveDupeChars(cell.Value)
  Next
End Sub

但这不允许我指定一个特定的字符来删除重复项，或者然后在字符串中找到它们的任何地方留下一个实例。

答案1

RemoveDupeChars() 函数运行良好。但它无法完成你的任务，因为它的目的是完全不同的东西。您需要 removeSpecificDupeChars() 函数：

Function removeSpecificDupeChars(sourceText As String, sChar As String)  As String
Dim aTemp As Variant 
Dim i As Long, j As Long
    aTemp = Split(sourceText, sChar)
    j = LBound(aTemp)
    For i = LBound(aTemp) + 1 To UBound(aTemp)
        If aTemp(i) <> "" Then
            j = j + 1
            aTemp(j) = aTemp(i)
        EndIf
    Next i
    ReDim Preserve aTemp(j)
    removeSpecificDupeChars = Join(aTemp, sChar)
End Function

您在问题中展示的程序应该修改：

Public Sub RemoveDupeChars3()
  Dim cell As Range
  For Each cell In Application.Selection
    cell.Value = removeSpecificDupeChars(cell.Value, ";")
  Next
End Sub

答案2

以下代码使用正则表达式，在几分之一秒内处理了超过 1000 行。

您需要根据需要更改范围引用。Selection如果必须，您可以使用。

请注意，在 VBA 数组中工作比重复访问工作表本身要快得多。

Option Explicit
Sub deDupSemiColons()
    Dim rg As Range, v, I As Long
    Dim WS As Worksheet
    Dim RE As Object

Set RE = CreateObject("vbscript.regexp")
    
Set WS = ThisWorkbook.Worksheets("Sheet1")
With WS

'Range is in column A starting at A1
    Set rg = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    v = rg
End With

With RE
    .Pattern = ";+"
    .Global = True
    
    For I = 1 To UBound(v, 1)
        v(I, 1) = RE.Replace(v(I, 1), ";")
    Next I
    
End With

rg.Value = v
End Sub

相关内容