Question

我正在尝试运行一个程序，该程序应该从电子表格中提取数据，将数据拆分为数据块，然后根据它的数据将其导入到我的表中。＆＃34;值＆＃34;变种。引入的数据格式如下所示：

＆＃34; HL＆＃34;，＆＃34; Hecla Mining Company Mining Stock＆＃34;，＆＃34; NSM＆＃34;，12.52,8.69,14.07,6.18

用于分割行，定义值以及将它们分配给列的代码目前编写如下：

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
           ***If InStr(sLine, ",Inc.") Then
            sLine = Replace(sLine, ",inc.", "")
        End If***
            Values = Split(sLine, ",")
            W.Cells(i + 2, 2).Value = Replace(Values(1), Chr(34), "")
            W.Cells(i + 2, 5).Value = Replace(Values(2), Chr(34), "")
            W.Cells(i + 2, 6).Value = Values(3)
            W.Cells(i + 2, 7).Value = Values(4)
            W.Cells(i + 2, 8).Value = Values(5)
            W.Cells(i + 2, 9).Value = Values(6)
            W.Cells(i + 2, 10).Value = Values(7)
            W.Cells(i + 2, 11).Value = Values(8)
            W.Cells(i + 2, 13).Value = Values(9)
        End If

问题出现在某些行返回一个包含逗号的名称，如下所示：

＆＃34; CDE＆＃34;，＆＃34; Coeur Mining，Inc。＆＃34;，＆＃34; NSM＆＃34;，7.59,16.25,9.52,7.01

这导致值（2）=＆＃34; Coeur Mining＆＃34;和价值（3）=＆＃34;公司＆＃34;而不是价值观（2）=＆＃34; Coeur Mining，Inc。＆＃34;和值（3）=＆＃34; NSM＆＃34;

我已尝试将代码更新为以下内容：

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

Dim regex As Object     
Set regex = CreateObject("vbscript.regexp")
regex.IgnoreCase = True
regex.Global = True
regex.Pattern = ",(?=([^" & Chr(34) & "]" & Chr(34) & "[^" & Chr(34) & "]" & Chr(34) & ")(?![^" & Chr(34) & "]" & Chr(34) & "))"
splitLine = Split(regex.Replace(line, ";"), ";") End Function
Values = splitLine(sLine)

然而，即使使用嵌套的If语句寻找＆＃34;，Inc。＆＃34;它似乎也没有起作用。在sLine字符串中。

是否存在我未获得的格式问题？我也尝试使用正则表达式函数，但我是excel / VBA的新手，并且无法弄清楚如何正确地格式化它。

建议的正则表达式代码如下：

Server Error in '/' Application.

Token Text in state Start would result in an invalid XML document. Make sure that the ConformanceLevel setting is set to ConformanceLevel.Fragment or ConformanceLevel.Auto if you want to write an XML fragment.  
  Description: An unhandled exception occurred during the execution of the current web request. Please review the stack trace for more information about the error and where it originated in the code. 

 Exception Details: System.InvalidOperationException: Token Text in state Start would result in an invalid XML document. Make sure that the ConformanceLevel setting is set to ConformanceLevel.Fragment or ConformanceLevel.Auto if you want to write an XML fragment. 

Source Error: 



Line 33:                 xslt.Load(xrt);
Line 34:         
Line 35:                 xslt.Transform(xri, xal, xwo);
Line 36:             }
Line 37:             out11.InnerHtml = sw.ToString();

非常感谢任何帮助，可根据要求提供更多信息或实际excel文件的副本。

Answer 1

看起来你将不得不通过一个'helper'函数处理字符串，该函数模仿Text-to-Columns的'quoted text'参数。

虽然不优雅（并且可能很容易改进），但这适用于您的样本。

Option Explicit

Sub test()
    Dim str As String, var As Variant

    str = """CDE"",""Coeur Mining, Inc."",""NSM"",7.59,16.25,9.52,7.01"
    With Worksheets("Sheet1")
        Debug.Print str
        str = cleanQuotedCommas(str)
        var = Split(str, Chr(44))
        With .Cells(2, "B").Resize(1, UBound(var) + 1)
            .Value = var
            .Replace what:=ChrW(8203), replacement:=Chr(44), lookat:=xlPart
            .Replace what:=Chr(34), replacement:=vbNullString, lookat:=xlPart
            .Value = .Value2
        End With
    End With
End Sub

Function cleanQuotedCommas(str As String) As String
    Dim i As Long, j As Long, k As Long
    i = InStr(1, str, Chr(34), vbBinaryCompare)
    Do While CBool(i)
        j = InStr(i + 1, str, Chr(34), vbBinaryCompare)
        k = InStr(i + 1, str, Chr(44), vbBinaryCompare)
        If k > i And k < j Then
            str = Replace(str, Chr(44), ChrW(8203), i, 1, vbBinaryCompare)
        End If
        Debug.Print str
        i = InStr(j + 1, str, Chr(34), vbBinaryCompare)
    Loop
    cleanQuotedCommas = str
End Function

注意文本的双精度和左对齐的真实数字的右对齐。

Answer 2

这是一个基于正则表达式的SplitLine函数，它将返回一个字符串数组。它会从包含它的条目中排除周围的引号，并且不会在“包含”的逗号上拆分：

Option Explicit

Public Function splitLine(line As String) As String()
  Dim regex As Object, matchcol As Object, match As Object
  Dim I As Long, S() As String

Set regex = CreateObject("vbscript.regexp")
With regex
    .Global = True
    .Pattern = """([^""\r\n]*)""|([^,\r\n]+)"
    If .test(line) = True Then
        Set matchcol = .Execute(line)
        ReDim S(0 To matchcol.Count - 1)
        I = 0

        'matches surrounded by quotes will be in 0
        'matches without quotes will be in 1
        For Each match In matchcol
            With match
                S(I) = .submatches(0) & .submatches(1)
            End With
            I = I + 1
        Next match
    End If
End With
splitLine = S
End Function

拆分分隔符必须设置为＆＃34;，＆＃34;但返回的值可能包括逗号

2 个答案: