将数组值拆分到正确的列中

Question

需要一些帮助来将值排序到正确的列中。我似乎无法弄清楚如何 return 数组值到 table.

中的正确列

对于 B 列的输出 "Pipe DN" 它应该 return 首先 从 "Line number" 中的值拆分文本 ，对于 "Service" 列 F 它应该 return 2nd 从 "Line number".

中拆分文本

我将如何做到这一点？ - 如果 "Pipe DN" 我使用 Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray，它将 return 给我正确的值，但是 "Service" 代码没有写在正确的列上。

Sub SplitLinesIntoArray()
    
    Dim LineNumber() As Variant
    Dim StrArray() As Variant
    Dim Dimension1 As Long, Counter As Long
    
    LineNumber = Range("J19", Range("J19").End(xlDown))
    
    Dimension1 = UBound(LineNumber, 1)
    
    ReDim StrArray(1 To Dimension1, 1 To 2)
    
    For Counter = 1 To Dimension1
        'Pipe DN
        StrArray(Counter, 1) = Split(LineNumber(Counter, 1), "-")(0)
        Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray
        'Service Code
        StrArray(Counter, 2) = Split(LineNumber(Counter, 1), "-")(1)
        Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
    Next Counter
    
    'Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray
    Erase LineNumber
    Erase StrArray
    
 End Sub

Answer 1

基本上，您可以通过分析 2-dim 数据字段数组并将生成的字符串操作 (Split()) 分配给它来开始。

结果似乎 (1) 正确输出第一个数组“列”（“管道 DN”，从单元格 B19 开始），而 (2) 第二列（“服务”，F19）重复每个数组“行”的最后一次拆分操作的结果。

此印象必须合格：

ad 1) 通过将 entire StrArray 分配给整个“管道 DN”列，您正在做不必要的额外工作，对每个单行迭代重复此操作。（请注意，StrArray 仅在最后一个循环中完全填充）。
ad 2) 基本上你每次迭代都会重新分配，但这次你只得到最新的拆分结果并填充整个“服务”列最新结果分配给 StrArray(Counter,2)。最终所有项目都显示最后的拆分结果，而不是单独的 LineNumber 拆分。

查看三个示例项目的这个缩写示例只是为了了解发生了什么（此快照显示代码在第二次迭代后停止时的 table 结果（即 Counter=2 后）：

即时帮助

坚持你的初始代码，我会省略

Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray 以及
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)

在 For..Next 循环中，但添加以下两行代码：

Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 1)
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 2)

为了 将 StrArray 切片 成列并将每一列分别写入您的单元格目标。

进一步说明：

完全限定您的范围引用以防止可能不想要的结果，因为Excel会采用当前活跃的sheet 如果没有明确引用......这不一定是目标之一:-;

使用 VBA，在标准办公情况下，没有必要在程序结束时清除 (Erase) 以释放内存。

避免数组切片的可能替代方案

您可能会从以下代码中获益，

完全符合您的参考范围（注意：不合格的参考邀请 Excel 无需请求即可使用当前有效的 sheet），
使用 锯齿状数组（aka 作为数组的数组）避免（多个）列切片（OP 中需要）
演示在模块顶部使用 Private Constants（此处用于枚举锯齿状数组
演示 帮助程序 以提供正确尺寸的锯齿状数组：

示例代码

Option Explicit                     ' declaration head of code module (forching variable declarations)

Private Const LineNum As Long = 0   ' enumerate sub-arrays within jagged array 
Private Const Pipe    As Long = 1
Private Const Service As Long = 2

Sub SplitLinesIntoJaggedArray()
'I. Set Worksheet object to memory               ' fully qualify any range references!
    Dim ws As Worksheet                          ' declare ws as of worksheet object type
    Set ws = Tabelle1                            ' << use the project's sheet Code(Name)
    'set ws = ThisWorkbook.Worksheets("Sheet1")  ' or: via a sheet's tabular name (needn't be the same)

With ws                                          ' With .. End With structure, note the following "."-prefixes
'II.Definitions
'a) assign target start cell addresses to array tgt
    Dim tgt As Variant
    tgt = Split("J19,B19,F19", ",")              ' split requires "Dim tgt" without brackets to avoid Error 13
'b) define source range object and set to memory
'   Note: tgt(LinNum) equalling tgt(0) equalling "J19"
    Dim src As Range
    Set src = .Range(tgt(LineNum), .Range(tgt(0)).End(xlDown))   ' showing both enumerations only for demo:-)
    Dim CountOfRows As Long: CountOfRows = src.Rows.Count        ' count rows in source range
'c) provide for a correctly dimensioned jagged array to hold all 2-dim data arrays (three columns)
    Dim JaggedArray() As Variant
    BuildJagged JaggedArray, CountOfRows     ' << call help procedure BuildJaggedArray

'III.Assign column data to JaggedArray
'a) assign LineNum column as 2-dim datafield to JaggedArray(LineNum)
    JaggedArray(LineNum) = src.Value
'b) assign LineNum splits to JaggedArray(Pipe) and JaggedArray(Service)
    Dim Counter As Long
    For Counter = 1 To CountOfRows
    '1. Pipe DN
        JaggedArray(Pipe)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(0)
    '2. Service Code
        JaggedArray(Service)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(1)
    Next Counter
        
'IV.Write result columns of jagged array to target addresses
'   Note: tgt(Pipe)=tgt(1)="B19", tgt(Service)=tgt(2)="F19"
    Dim elem As Long
    For elem = Pipe To Service
        .Range(tgt(elem)).Resize(CountOfRows, 1) = JaggedArray(elem)
    Next

End With
End Sub

*帮助程序BuildJagged

请注意，第一个过程参数传递交错数组 By Reference（=默认值，如果未显式传递 ByVal). 这意味着帮助过程中的任何进一步操作都会立即对原始数组产生影响。

Sub BuildJagged(ByRef JaggedArray, ByVal CountOfRows As Long)
'Purpose: provide for correct dimensions of the jagged array passed By Reference
        ReDim JaggedArray(LineNum To Service)   ' include LineNum as data base (gets dimmed later)
        Dim tmp() As Variant
        ReDim tmp(1 To CountOfRows, 1 To 1)
        Dim i As Long
        For i = Pipe To Service                 ' suffices here to start from 1=Pipe to 2=Service
            JaggedArray(i) = tmp
        Next i
End Sub

进一步link

Error in finding last used cell in Excel VBA

将数组值拆分到正确的列中

Splitting array values into the correct column

arrays

excel

vba

multidimensional-array