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

Question

我需要删除仅围绕单个单词的引号，保留围绕双字的引号。

所以...

"Orange","Yellow Banana","Red Apple"
应该是：
Orange,"Yellow Banana","Red Apple"

和

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

Answer 1

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

Answer 2

如果您的列表格式不正确（缺少空格或额外的标点符号），这可以工作，但它不是最佳的:)

您没有指定文本在哪里或如何访问它，所以只是做了任何事情:)

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 一起添加，您将在宏列表中获得“fixMacro”，当您运行宏时，它将在活动单元格上运行该函数，并将其值替换为固定版本。