Excel-VBA分割string并将结果存储到单独的数组中
格式Topic/Subtopic有很多string。 我需要将它们分开，并将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
现在我想要在分开的数组中分割的部分，因为我想稍后访问它们。 任何帮助？
没有必要迭代两次，首先通过单元格，然后通过数组。
你可以像这样做一个迭代：
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
正如你所看到的，我还发布了Function GetLastRow()来获取要扫描的数据的最后一行索引。
根据你的代码，我想你想在第4行开始，并停在第一个空白单元格（排除），所以我调整了参数（即第三个： "F" ）相应地调用GetLastRow 。
相反，如果要扫描给定列中的所有非空白单元格，则可以调用传递"L"作为第三个参数的同一个GetLastRow函数。
2解决scheme：一个2Darrays或两个1Darrays
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之前，先p数组进行redim preserve 。
' Either redim preserve arr_Multi(p, 2) 'or redim preserve arr_Topic(p) redim preserve arr_SubTopic(p)