Excel VBA：查找具有相似值的单元格答案

【问题标题】：Excel VBA: Find cells with similar valuesExcel VBA：查找具有相似值的单元格
【发布时间】：2016-08-31 21:23:16
【问题描述】：

对我来说又是一项艰巨的任务......

我有一个这样的 Excel 表格...

第一列有两个Aas，它们的值显示在第二列，分别是A string和Astring。

A string 和Astring仅与一个空白键不同。我想用 excel VBA 说，这两个值是相等的，只要它们在第一列中相同，但仅与第二列中的一个字母不同。然后应该删除其中之一。 [显示在“目标”部分]

同样，有两个Dds，它们的值仅与;不同。

在这里我写了一些代码，但我不知道如何做if algorithmus。

Sub deletesimilars()

    Dim lr As Long

    lr = ActiveSheet.UsedRange.Rows.Count

    For i = lr To 1 Step -1  'reverse loop
       If Cells(i, 1) = Cells(i - 1, 1) Then
'           if cells(i,2) ??? cells(i-1,2) then     ' I stuck here
                Cells(i, 1) = ""
                Cells(i, 2) = ""
            End If
        End If
    Next i

End Sub

谢谢！！！

【问题讨论】：

我意识到您的示例（几乎可以肯定）只是一个示例，但是如果切换了两个“Dd”值，您是否希望“A;number”成为与“A number”保持一致的值被删除？
@YowE3K 会好的。这个 VBA 程序的目的是删除一些具有相似性的重复项。如果之后我必须手动更改这些值，那就没问题了。

标签： excel vba

【解决方案1】：

当我想保证某个字符串的“等价性”时，我在工作中遇到过这个问题。所以我的技术是通过关注字符串的重要内容来“规范化”字符串。

在我的大多数情况下，这意味着：

去除所有空格（通常不重要）
将所有内容都转换为小写（大小写对我来说通常并不重要）
有时会忽略某些特殊字符

所以我有一个名为NormalizeString 的实用函数来执行这些操作。

然后你的代码变成：

Option Explicit

Sub DeleteSimilars()
    Dim thisSH As Worksheet
    Dim lastRow As Long
    Set thisSH = ActiveSheet
    lastRow = thisSH.UsedRange.Rows.Count

    Dim i As Long
    For i = lastRow To 2 Step -1
        If thisSH.Cells(i, 1) = thisSH.Cells(i - 1, 1) Then
            If NormalizeString(thisSH.Cells(i, 2), ";") = _
               NormalizeString(thisSH.Cells(i - 1, 2), ";") Then
                thisSH.Cells(i, 1) = vbNullString
                thisSH.Cells(i, 2) = vbNullString
            End If
        End If
    Next i
End Sub

Function NormalizeString(ByVal inputStr As String, _
                         Optional ByVal specialChars As String) As String
    '--- "normalizes" a string by a series of modifications, such as
    '      -- removes all whitespace
    '      -- converts all characters to lowercase
    '      -- removes other "special" characters that should not
    '         be considered part of the string
    Dim returnString As String
    returnString = Replace(inputStr, " ", "", , , vbTextCompare)
    returnString = LCase(returnString)
    If Not IsMissing(specialChars) Then
        Dim i As Integer
        For i = 1 To Len(specialChars)
            returnString = Replace(returnString, _
                                   Mid(specialChars, i, 1), "", , , vbTextCompare)
        Next i
    End If
    NormalizeString = returnString
End Function

【讨论】：