提取引号之间的文本并移至下一个单元格/行vba

Question

我在A列中的引号之间有不同的文字；我想提取引号之间的文本，然后将文本移到不带引号的下一列（B）。

Sub ExtractText() 
    Dim iPos1 As Integer 
    Dim iPos2 As Integer 

    iPos1 = InStr(Sheet1.Cells(2, 1), """ ") 
    iPos2 = InStr(Sheet1.Cells(2, 1), " """) 

    Sheet1.Cells(2, 2) = Trim(Mid(Sheet1.Cells(2, 1), iPos1 + 1, iPos2 - iPos1 - 1)) 
End Sub

Answer 1

由于已经提出了Split，下面是一个示例：

Sub ExtractText()
    Dim splitText As Variant
    splitText = Split(Sheet1.Cells(2, 1).Value, """")

    Sheet1.Cells(2, 2).Value = Trim$(splitText(1))
End Sub

一个例子：

Answer 2

仅供参考，一个简单的功能就可以做到这一点：

=IF(ISNUMBER(FIND("""",A2)),TRIM(MID(SUBSTITUTE(A2,"""",REPT(" ",999)),999,999)),A2)

Answer 3

基于需要：

• 使用VBA
• 循环列A
• 仅在返回双引号（大于1）时才提取

尝试下面的代码：

Sub Test()

Dim arr As Variant
Dim lr As Long, x As Long

With Sheet1 'Change according to your sheet's CodeName
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:A" & lr).Value
    For x = LBound(arr) To UBound(arr)
        If InStr(1, arr(x, 1), """") < InStrRev(arr(x, 1), """") Then
            .Cells(x, 2) = Trim(Split(arr(x, 1), """")(1))
        Else
            '.Cells(x, 2) = arr(x, 1) ': Remove the single quote if need be
        End If
    Next x
End With

End Sub