Question

我正在尝试创建的宏将扫描一系列单元格，提取唯一的特殊字符，并将它们放在不断增长的唯一特殊字符列表中（即不会列出两次特殊字符）。

我使用过来自不同来源的代码，但我遇到的最后一个问题是，当我尝试将列中的下一个空单元格设置为特殊字符时，Excel会生成1004：应用程序定义的对象或对象 - 面向错误。

Sub Main()
Dim sCharOk As String
Dim s As String
Dim r As Range, rc As Range
Dim j As Long

sCharOk = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,-() ~!@#%^&*()_+?'."
Set r = Range("A1:A10")

For Each rc In r
    s = rc.Value
    For j = 1 To Len(s)
        If InStr(sCharOk, Mid(s, j, 1)) = 0 And Application.WorksheetFunction.CountIf(Range("B1:B100"), Mid(s, j, 1)) = 0 Then
            rc.Interior.Color = vbYellow
            Mid(s, j, 1) = Range("B1").End(xlDown).Offset(1, 0)
            Exit For
        End If
    Next j
Next rc
End Sub

有没有办法告诉Excel将其识别为合法对象或不是问题？

Answer 1

Sub Main()

    Dim sCharOk As String
    Dim s As String
    Dim r As Range, rc As Range
    Dim j As Long

    sCharOk = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,-() ~!@#%^&*()_+?'."
    Set r = Range("A1:A10")

    For Each rc In r
        s = rc.Value
        For j = 1 To Len(s)
            If InStr(sCharOk, Mid(s, j, 1)) = 0 And _
                  Application.CountIf(Range("B1:B100"), Mid(s, j, 1)) = 0 Then

                rc.Interior.Color = vbYellow

                Cells(rows.count,2).End(xlUp).offset(1,0).value = Mid(s, j, 1)

                Exit For '<<< remove if you want to capture all special chars

            End If
        Next j
    Next rc

End Sub

Answer 2

您可以使用Dictionary对象来处理唯一值

这是一个后期绑定字典实例

的示例

Option Explicit

Sub Main()
    Dim sCharOk As String
    Dim s As String
    Dim r As Range, rc As Range
    Dim j As Long

    sCharOk = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789,-() ~!@#%^&*()_+?'."
    Set r = Range("A1:A10")

    With CreateObject("Scripting.Dictionary") '<--| instantiate a 'Dictionary' object
        For Each rc In r
            s = rc.Value
            For j = 1 To Len(s)
                If InStr(sCharOk, Mid(s, j, 1)) = 0 Then
                    .Item(Mid(s, j, 1)) = .Item(Mid(s, j, 1)) + 1 '<--| stores invalid character in dictionary keys, if not already there
                    rc.Interior.Color = vbYellow
                    Exit For
                End If
            Next j
        Next rc
        Cells(Rows.count, 2).End(xlUp).Offset(1, 0).Resize(.count).Value = Application.Transpose(.Keys) '<--| write down dictionary keys (i.e. unique invalid characters)
    End With
End Sub

子字符串未被识别为值

2 个答案: