Question

我有一个文本字符串，我想用VBA分割。我无法弄清楚如何以所需的格式输出它。

目标是将5个字符串中的每一个分成一个数组，但我创建的For循环只是反复分割相同的字符串。

我们的想法是将每个字符串拆分为设备信息，这样就可以将其转储到FTP上传Excel工作表中。

这是我目前的代码：

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字符串拆分输出？

2 个答案: