Arrays Excel VBA拆分字符串并将结果存储到单独的数组中

我有许多字符串的格式是

主题/子主题

。我需要将它们分开，并将topic和subtopic的结果存储到不同的数组中

我的代码是：

Dim strText() As String
Dim seperate As Variant

i = QB_StartCell '4

ReDim strText(1 To 25)

'collecting all the types in an array
Do While Worksheets("QB").Cells(i, QB_Thema).Value <> ""  'QB_Thema is a column number
    strText(i) = Worksheets("QB").Cells(i, QB_Thema).Value
    MsgBox strText(i)
    i = i + 1
Loop

noThema = i - QB_StartCell

'splitting all the types into 2 parts
Do
    
seperate = Split(strText(p), "/")

Loop Until p > noThema

Dim strText（）作为字符串
作为变体分离
i=QB_StartCell'4
ReDim strText（1到25）
'收集数组中的所有类型
Do While工作表（“QB”）。单元格（i，QB_Thema）。值“”QB_Thema是一个列号
strText（i）=工作表（“QB”）.单元格（i，QB_Thema）.值
MsgBox strText（一）
i=i+1
环
noThema=i-QB_标准单元
'将所有类型拆分为两部分
做
分离=分离（strText（p），“/”）
循环直到p>noThema

---

现在，我希望这两个分割的部分在单独的数组中，因为我希望稍后访问它们。有什么帮助吗？

2种解决方案：一个2D阵列或两个1D阵列

Dim arr_Multi(noThema, 2) As String
Dim arr_Topic(noThema) As String
Dim arr_SubTopic(noThema) As String

Do
    seperate = Split(strText(p), "/")

    ' Choose either storage in one 2D array
        arr_Multi(p, 0) = seperate(0)
        arr_Multi(p, 1) = seperate(1)

    ' or storage in two 1D arrays
        arr_Topic(p) = seperate(0)
        arr_SubTopic(p) = seperate(1)

    p = p + 1 ' and don't forget to increment your counter in the loop

Loop Until p > noThema

---

如果需要子模块外部的数组，则应在模块顶部声明它们：

Dim arr_Multi(1, 2) As String
Dim arr_Topic(1) As String
Dim arr_SubTopic(1) As String

在循环中，在递增

p

之前，对数组执行

redim preserve

：

' Either
redim preserve arr_Multi(p, 2)

'or 
redim preserve arr_Topic(p)
redim preserve arr_SubTopic(p)

---

不需要迭代两次，首先遍历单元格，然后遍历数组

您可以在一次迭代中完成，如下所示：

Option Explicit

Sub main()
Dim i As Long, lastRow As Long, nonBlankCellsNumber As Long
Dim QB_Thema As Long, QB_StartCell As Long
Dim cell As Range
Dim topicArr() As String, subTopicArr() As String

QB_Thema = 3 'added this for my test
QB_StartCell = 4

lastRow = GetLastRow(Worksheets("QB"), QB_Thema, "F", QB_StartCell) '<== I assumed as per your code that you stop at the first occurrence of a blank cell. should you want to process all non blank data to the last non blank cell, then use "L" as the 3rd argument of this call
If lastRow = -1 Then Exit Sub

With Worksheets("QB")
    With .Range(.Cells(QB_StartCell, QB_Thema), .Cells(lastRow, QB_Thema))
        nonBlankCellsNumber = WorksheetFunction.CountA(.Cells)
        ReDim topicArr(1 To nonBlankCellsNumber)
        ReDim subTopicArr(1 To nonBlankCellsNumber)
        i = 0
        For Each cell In .Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
            i = i + 1
            topicArr(i) = Split(cell.value, "/")(0)
            subTopicArr(i) = Split(cell.value, "/")(1)
        Next cell
    End With
End With

End Sub


Function GetLastRow(sht As Worksheet, columnIndex As Long, FirstOrLastBlank As String, Optional firstRow As Variant) As Long
If IsMissing(firstRow) Then firstRow = 1
With sht
    If FirstOrLastBlank = "F" Then
        With .Cells(firstRow, columnIndex)
            If .value = "" Then
                GetLastRow = .End(xlDown).End(xlDown).row
            Else
                GetLastRow = .End(xlDown).row
            End If
        End With
        If GetLastRow = .Rows.count And .Cells(GetLastRow, columnIndex) = "" Then GetLastRow = firstRow
    ElseIf FirstOrLastBlank = "F" Then
        GetLastRow = .Cells(.Rows.count, columnIndex).End(xlUp).row
        If GetLastRow < firstRow Then GetLastRow = firstRow
    Else
        MsgBox "invalid 'FirstOrLastBlank' parameter"
        GetLastRow = -1
    End If
End With
End Function

选项显式
副标题（）
Dim i为长，lastRow为长，非空白单元格数为长
调暗QB_Thema的长度，QB_StartCell的长度
暗淡单元格作为范围
Dim topicArr（）作为字符串，subTopicArr（）作为字符串
QB_Thema=3'为我的测试添加了此项
QB_StartCell=4
lastRow=GetLastRow（工作表（“QB”），QB_Thema，“F”，QB_StartCell）
separate（0）
将为您提供
主题
和
separate（1）
将为您提供
子主题
同样，在上一个Do循环中，您没有增加或减少
p
它在
arr\u Topic（p）=separate（0）
行给出了一个错误
下标超出范围
。我猜这是由于数组的尺寸。我也提到了
redim preserve
。这是因为您的
separate=Split（strText（p），“/”
不返回数组，可能是因为
strText（p）
为空或不包含任何
//code>。我们不知道你的数据。你必须调整代码以匹配它。嗨，谢谢你的建议。是的，你在写信。从循环中出来后，
strText（p）
变为空。我不明白为什么。在循环内部，当我打印它时，它显示值，但在外部它变为空。我搞错了。数组超出了边界。