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

【问题标题】：Find Replace quotes only around single words查找仅在单个单词周围替换引号
【发布时间】：2012-06-28 20:34:38
【问题描述】：

我只需要删除单个单词周围的引号，保留双单词周围的引号。

所以...

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

与

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

【问题讨论】：

是在单独的单元格中的每个单词/单词组（即 A1="Orange", A2="Yellow Banana", ...）还是在单个单元格中的整个字符串（即 A1= "Orange","Yellow Banana",...)?
如果您可以使用正则表达式（例如 Notepad++ 或一些 VBA 代码）会很简单 - 将 "([^", ]+)" 替换为 \1（第一个捕获组）
单个单元格 - 我确实有 notepad++ 并且可以复制进出，但是您粘贴的标准在 notepad++ 中不起作用。
我不反对通过逗号使用文本到列来分隔和重新连接，但是逗号之间最多有 6 个值，我仍然没有一个很好的方法来删除引号单字……

标签： excel

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

【讨论】：

我只使用/记录了一些宏。我只是将它粘贴到我工作簿中的一个新模块中，但它没有出现在我的工作表的宏中。有什么想法吗？
首先，非常感谢您的帮助，非常感谢！不过，一旦我保存并退出 MS Visual Basic，我仍然无法在我的宏中显示它..
啊，我的错。它目前是您可以在工作表中的论坛中使用的功能。例如：“=fixQuotes2(A1)”，其中 A1 是源文本，当您放置时，单元格将包含固定版本
哦，完美！抱歉耽搁了，但这很有效，可以救命，谢谢，谢谢！

【解决方案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

【讨论】：