Question

我需要删除仅包含单个单词的引号，并将其保留在双字词周围。

... SO

“橘子”，“黄香蕉”，“红苹果”
应该是这样的：
橙色，“黄色香蕉”，“红苹果”

和

“黄香蕉”，“红苹果”，“橙子”
应该是这样的：
“黄香蕉”，“红苹果”，橙子

Answer 1

如果你的列表没有正确格式化（缺少空格或额外的标点符号），那么快速去，这可行，但它不是最佳:)

您没有指定文本的位置或访问它的方式只是做了以下任何事情：）

Public Sub fixQuotes(ByVal Target As Range)
Dim Words() As String
Dim Word As String
Dim Index As Long
Dim Result As String

Words = Split(Target.Value, " ")

Result = ""

For Index = LBound(Words) To UBound(Words)
    Word = Words(Index)

    Word = Replace(Word, ",", "")
    Word = Replace(Word, ".", "")

    If Left(Word, 1) = Chr(34) And Right(Word, 1) = Chr(34) Then

        Result = Result & Replace(Words(Index), Chr(34), "") & " "

    Else

        Result = Result & Words(Index) & " "

    End If

Next Index

Target.Value = Result

End Sub

看了你的例子后，我发现前一个例子根本不会很好（它需要列表项之间的空格）

所以我做了一个新的：）

Public Function fixQuotes2(ByVal Text As String) As String
Dim Index As Integer
Dim Character As String
Dim Quote As Boolean
Dim A As Integer
Dim Result As String

Index = 1

Do

    If Mid(Text, Index, 1) = Chr(34) And Index < Len(Text) Then
        A = 1
        Quote = False
        Do
            Character = Mid(Text, Index + A, 1)

            If Character = " " Then
                Quote = True
            End If
            If Character = Chr(34) Then
                Exit Do
            Else
                If Index + 1 >= Len(Text) Then
                    Exit Do
                Else
                    A = A + 1
                End If
            End If
        Loop

        If Quote = True Then
            Result = Result & Mid(Text, Index, A + 1)
        Else
            Result = Result & Mid(Text, Index + 1, A - 1)
        End If
        Index = Index + A + 1
    Else
        If Index >= Len(Text) Then
            Exit Do
        Else
            Result = Result & Mid(Text, Index, 1)
            Index = Index + 1
        End If
    End If
Loop

    fixQuotes2 = Result

End Function

这个可以用作工作表函数，与第一个不同。

注意：确保在尝试之前保存了您的资料！（制作时有几个无限循环：p）

Public Sub fixMacro()
ActiveCell.Value = fixQuotes2(CStr(ActiveCell.Value))
End Sub

将它与fixQuotes2一起添加，你将获得＆＃34; fixMacro＆＃34;在宏列表中，当您运行宏时，它将在活动单元格上运行该函数，并将其值替换为固定版本。

Answer 2

Sub DeQuoteSingleWords()

    Dim c As Range, arr, x

    For Each c In Selection.Cells
        arr = Split(Trim(c.Value), ",")
        For x = LBound(arr) To UBound(arr)
            arr(x) = Trim(arr(x))
            If InStr(arr(x), " ") = 0 Then
                arr(x) = Replace(arr(x), """", "")
            End If
        Next x
        c.Offset(0, 1).Value = Join(arr, ", ")
    Next c

End Sub

查找仅在单个单词周围替换引号

2 个答案: