Question

目前我在VBA / RegEx上非常新，我已经定义了RegEx功能

Public Function splitLine(line As String) As String()

Dim regex As Object
Set regex = CreateObject("vbscript.regexp")
regex.IgnoreCase = True
regex.Global = True

'This pattern matches only commas outside quotes
'Pattern = ",(?=([^"]"[^"]")(?![^"]"))"
regex.Pattern = ",(?=([^" & Chr(34) & "]" & Chr(34) & "[^" & Chr(34) & "]" & Chr(34) & ")(?![^" & Chr(34) & "]" & Chr(34) & "))"


splitLine = Split(regex.Replace(line, ";"), ";")

End Function

我用以下方式引用它：

Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbLf)
Dim sLine As String
Dim Values As Variant

For i = 0 To UBound(Lines)
    sLine = Lines(i)
    Values = splitLine(sLine)

    Stop

Next i

这并没有发生错误 - 没有发生分裂。

感谢您的帮助！

Answer 1

Regex to pick commas outside of quotes上的本地文章有一些略有不同的模式字符串，看起来很成功。

'Pattern = /^([^"]|"[^"]*")*?(,)/
regex.Pattern = "/^([^" &  Chr(34) & "]|" &  Chr(34) & "[^" &  Chr(34) & "]*" &  Chr(34) & ")*?(,)/"

'Pattern = /(,)(?=(?:[^"]|"[^"]*")*$)/
regex.Pattern = "/(,)(?=(?:[^" &  Chr(34) & "]|" &  Chr(34) & "[^" &  Chr(34) & "]*" &  Chr(34) & ")*$)/"

我还建议拆分不太常见的分隔符。 ChrW（8203）（零长度unicode空间）是原子等的常见分隔符。

splitLine = Split(regex.Replace(line, ChrW(8203)), ChrW(8203))

我使用另一种正则表达式模式剔除了一个工作函数

Function stripCommasOutsideOfQuotedString(rng As Range)

    Dim strPattern As String
    Dim regEx As Object

    Set regEx = CreateObject("VBScript.RegExp")
    'pattern is: ,(?=([^"]*"[^"]*")*(?![^"]*"))
    strPattern = ",(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"
    'Debug.Print strPattern

    With regEx
        .Global = True
        .Pattern = strPattern
    End With

    stripCommasOutsideOfQuotedString = Split(regEx.Replace(rng.Value, ChrW(8203)), ChrW(8203))
End Function

可以将上述函数数组输入到一系列列中以接收拆分值。

Answer 2

我不是程序员，无论如何，但我已经设法将这个小家伙拼凑起来从雅虎财经中获取股票信息。想我会把它留在这里：

Function stripCommasOutsideOfQuotedString(rng As String) As String()

Dim strPattern As String
Dim regEx As Object

Set regEx = CreateObject("VBScript.RegExp")
'pattern is: ,(?=([^"]*"[^"]*")*(?![^"]*"))
strPattern = ",(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"
'Debug.Print strPattern

With regEx
    .Global = True
    .Pattern = strPattern
End With

stripCommasOutsideOfQuotedString = Split(regEx.Replace(rng, ChrW(8203)), ChrW(8203))

End Function

Private Sub btnRefresh_Click()
  Dim W As Worksheet: Set W = ActiveSheet
  Dim Last As Integer: Last = W.Range("A1000").End(xlUp).Row
  If Last = 1 Then Exit Sub
  Dim Symbols As String
  Dim i As Integer
  For i = 2 To Last
    Symbols = Symbols & W.Range("A" & i).Value & "+"
  Next i
  Symbols = Left(Symbols, Len(Symbols) - 1)


  Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=npobat8mwva2j1rey"



  Dim Http As New WinHttpRequest
  Http.Open "GET", URL, False
  Http.Send

  Dim Resp As String: Resp = Http.ResponseText
  Dim Lines As Variant: Lines = Split(Resp, vbLf)
  Dim sLine As String
  Dim Values As Variant
  For i = 0 To UBound(Lines)
    sLine = Lines(i)
    If InStr(sLine, ",") > 0 Then

        Values = stripCommasOutsideOfQuotedString(sLine)
        W.Cells(i + 2, 2).Value = Replace(Values(0), Chr(34), "")
        W.Cells(i + 2, 3).Value = Replace(Values(1), Chr(34), "")
        W.Cells(i + 2, 4).Value = Replace(Values(2), Chr(34), "")
        W.Cells(i + 2, 5).Value = Replace(Values(3), Chr(34), "")
        W.Cells(i + 2, 6).Value = Replace(Values(4), Chr(34), "")
        W.Cells(i + 2, 7).Value = Replace(Values(5), Chr(34), "")
        W.Cells(i + 2, 8).Value = Replace(Values(6), Chr(34), "")
        W.Cells(i + 2, 9).Value = Replace(Values(7), Chr(34), "")
        W.Cells(i + 2, 10).Value = Replace(Values(8), Chr(34), "")
        W.Cells(i + 2, 11).Value = Replace(Values(9), Chr(34), "")
        W.Cells(i + 2, 12).Value = Replace(Values(10), Chr(34), "")
        W.Cells(i + 2, 13).Value = Replace(Values(11), Chr(34), "")
        W.Cells(i + 2, 14).Value = Replace(Values(12), Chr(34), "")
        W.Cells(i + 2, 15).Value = Replace(Values(13), Chr(34), "")
    End If
Next i
W.Cells.Columns.AutoFit

End Sub

使用RegEx在VBA中拆分字符串 - 不拆分

2 个答案: