如何正确格式化 VBA 字符串拆分输出？

Question

我有一个文本字符串，我想使用 VBA 拆分它。我不知道如何以所需的格式输出它。

objective是将5个字符串分别拆分成一个数组，但是我创建的For循环只是把相同的字符串一遍又一遍地拆分。

想法是根据设备信息拆分每个字符串，因此可以将其转储到 FTP 上传 excel sheet.

这是我目前拥有的代码：

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    For intCount = 1 To 6
        text_string = Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
    Next intCount

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")

    For intCount = 1 To 6
        o.Sheets("sheet1").Range("B19:F25").Value = WrdArray()
    Next intCount
End Sub

这是源数据：

UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10045597**YR: 2012          **MAKE: KENT**MODEL: KF 4 SS**SERIAL/VIN #: 1984**TYPE OF EQUIPMENT: SKID STEER/MINI EXCAVATOR BREAKER**ORIGINAL EQUIPMENT COST: 3832.71**
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10251995**YR:  2015         **MAKE: STIHL**MODEL: TS420:14**SERIAL/VIN #: 177734255**TYPE OF EQUIPMENT: CUT OFF SAW**ORIGINAL EQUIPMENT COST: 730.00** **EQ # : 10353520**YR:  2015         **MAKE: DEWALT**MODEL: D25980K**SERIAL/VIN #: 007379**TYPE OF EQUIPMENT: DEMO HAMMER**ORIGINAL EQUIPMENT COST: 1118.78** ** **EQ # : 10326567**YR:  2015         **MAKE: HILTI**MODEL: TE60:ATC**SERIAL/VIN #: 71248**TYPE OF EQUIPMENT: ROTARY HAMMER**ORIGINAL EQUIPMENT COST: 1115.49** ** **EQ # : 10335480**YR:  2015         **MAKE: STIHL**MODEL: TS420**SERIAL/VIN #: 179146608**TYPE OF EQUIPMENT: CUT OFF SAW**ORIGINAL EQUIPMENT COST: 824.96** **EQ # : 10331620**YR:  2014         **MAKE: DEWALT**MODEL: D25980K**SERIAL/VIN #: 006159**TYPE OF EQUIPMENT: DEMO HAMMER**ORIGINAL EQUIPMENT COST: 1117.42**
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10189822**YR:  2013         **MAKE: MULTIQUIP**MODEL: DCA70SSJU4I**SERIAL/VIN #: 7305316**TYPE OF EQUIPMENT: GENERATOR**ORIGINAL EQUIPMENT COST: 33068.65
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 1226605**YR: 2011          **MAKE: MULTIQUIP**MODEL: GAW180HE1**SERIAL/VIN #: 5653875**TYPE OF EQUIPMENT: WELDER**ORIGINAL EQUIPMENT COST: 2442.03
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 1219041**YR: 2011          **MAKE: WACKER**MODEL: BS 60:2I**SERIAL/VIN #: 20036780**TYPE OF EQUIPMENT: RAMMER**ORIGINAL EQUIPMENT COST: 2642.09
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10391557**YR: 2015          **MAKE: WACKER**MODEL: WP1550AW**SERIAL/VIN #: 30101214**TYPE OF EQUIPMENT: VIB PLATE**ORIGINAL EQUIPMENT COST: 1499.52** **EQ # : 10305672**YR: 2014          **MAKE: TOW MASTER**MODEL: T:5DT**SERIAL/VIN #: 4KNTT1210FL160572**Lic. Plate**: MO / 63E0HL**TYPE OF EQUIPMENT: TRAILER**ORIGINAL EQUIPMENT COST: 4887.14**

Answer 1

尝试在下面添加：Sheets("Sheet1").Range("C" & intCount & ":G" & intCount).Value = WrdArray() WrdArray() = Split(text_string, "EQ # : ") 这会让您了解如何查看每次拆分的结果，并且应该让您很容易从中找出结果那里。

Answer 2

您遇到的问题是逻辑问题。第一个 "For" 循环将运行 6 次，每次覆盖 "WrdArray()" 以便在循环结束时它等于最终值。

第二个 "For" 循环将这个最终值粘贴到 6 个不同的单元格中。

要解决此问题，请重新排序代码：

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")


    For intCount = 1 To 6

        text_string = sheets("mySheet").Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
        o.Sheets("sheet1").Range("B" & (18 + intCount) & ":F" & (18+intCount)).Value = WrdArray()

    Next intCount


End Sub

请注意，您还需要在循环中更改要粘贴到的单元格，否则数据将被覆盖。

或者，您可以使用数组数组：

Sub Break_String()
    Dim arArrays() As Variant
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    ReDim arArrays(1 To 6)

        For intCount = 1 To 6

            text_string = sheets("mySheet").Cells(intCount, 2)
            WrdArray() = Split(text_string, "EQ # : ")
            arArrays(intCount) = WrdArray()

         Next intCount

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")

    For intCount = 1 To 6

        o.Sheets("sheet1").Range("B" & (18 + intCount) & ":F" & (18+intCount)).Value = arArrays(intCount)

    Next intCount

End Sub

编辑*** 修复了从数组到单元格的行赋值错误。需要在范围内添加“：”。还将“24”更改为“18”，因为结果应该都在同一行。

在解决这个问题时，注意到 "Cells(intCount, 2)" 没有引用工作表。已更新以引用工作表，但应在此处添加正确的工作表名称，而不是 "mySheet."

EDIT2***

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object
    Dim pasteRow As Integer
    Dim i As Integer

    pasteRow = 19

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")


    For intCount = 1 To 6

        text_string = sheets("mySheet").Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
        For i = LBound(WrdArray) to UBound(WrdArray)
            o.Sheets("sheet1").Range("B" & (pasteRow)).Value = WrdArray[i]
            pasteRow = pasteRow + 1
        Next i
    Next intCount


End Sub

这将按照评论中的要求进行。

如何正确格式化 VBA 字符串拆分输出？

How to Format VBA String Split Output Correctly?

excel

vba

output