Question

背景：

试图设法在一张纸上处理大量表格并遇到锯齿形数组（此处为“ Jar s”）的有效方法。

为了简单地了解Jars的一些基础知识，我试图构建一个交错信息的简单方案，以便能够创建Jar。

我的Jar标有big_arr，内部的每个数组都称为lil_arr。

以下是该场景的数据：

   ColA 'adding row number in front of each word
1  cat
2  dog
3
4  mouse
5  elephant
6
7  zebra
8  snake
9
10 cheese
11 pickle
12
13 anteater
14 mirkat
15
16 skunk
17 smurf

在上述情况下，big_arr(2) = lil_arr其中`lil_arr = array（“ mouse”，“ elephant”）。

然后我将big_arr(i)打印到一张纸上；循环时，工作表被标记为i。因此工作表2将具有cells(1,1).value = "mouse"和cells(1,2).value = "elephant"。

问题：

我在按预期方式打印数据时遇到问题。

正在发生的确切打印（基于i作为工作表名称）

1有cells(1,1).value = 0
2有cells(1,1).value = "skunk"
3有cells(1,1).value = 0
4有cells(1,1).value = 0
5有cells(1,1).value = 0
6有cells(1,1).value = 0

我似乎无法使用Application.Transpose(big_arr(i))打印。我试图循环，但似乎没有适当的语法。

问题：

希望能为解决Application.Transpose()问题而提供的任何帮助而不会触发错误消息。

否则，帮助使循环以适当的语法运行的帮助将是惊人的。

相关代码：

带有Application.Transpose()的代码用于打印

Sub create_jagged_array_of_tables()
    Dim big_arr As Variant, lil_arr As Variant, lr As Long, i As Long, j As Long, k As Long, ws As Worksheet
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim big_arr(1 To lr)
    For i = 1 To lr
        j = 1
        Do Until IsEmpty(Cells(i + j, 1))
            j = j + 1
        Loop
        If j > 1 Then
            lil_arr = Cells(i, 1).Resize(j).Value
            big_arr(j) = lil_arr
            i = i + j
            k = k + 1
        Else
            MsgBox "row " & i & " is not part of an array"
        End If
    Next i
    For i = 1 To k
        Set ws = Sheets.Add
        ws.Name = i
        Cells(1, 1).Value = Application.Transpose(big_arr(i))
    Next i
End Sub

我尝试的循环代码，给出类型不匹配，仅关注for i = 1 to k循环：

    For i = 1 To k
        Set ws = Sheets.Add
        ws.Name = i
        'Cells(1, 1).Value = Application.Transpose(big_arr(i))
        For j = 1 To UBound(big_arr(i), 1)
            Cells(j, 1).Value = big_arr(i)(j)
        Next j
    Next i

Answer 1

在这种情况下，j将始终等于2行：

big_arr(j) = lil_arr

因此您会不断覆盖它。

我假设您要在big_arr的计数器中使用k而不是j：

big_arr(k) = lil_arr

但这将要求您在i循环之前将k = 1。

还需要将输出调整为lil_array的大小：

Sub create_jagged_array_of_tables()
    Dim big_arr As Variant, lil_arr As Variant, lr As Long, i As Long, j As Long, k As Long, ws As Worksheet
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim big_arr(1 To lr)
    k = 0
    For i = 1 To lr
        j = 1
        Do Until IsEmpty(Cells(i + j, 1))
            j = j + 1
        Loop
        If j > 1 Then
            lil_arr = Cells(i, 1).Resize(j).Value
            k = k + 1
            big_arr(k) = lil_arr
            i = i + j                
        Else
            MsgBox "row " & i & " is not part of an array"
        End If
    Next i

    For i = 1 To k
        Set ws = Sheets.Add
        ws.Name = i
        Cells(1, 1).Resize(1, UBound(big_arr(i), 1)).Value = Application.Transpose(big_arr(i))
    Next i
End Sub

Answer 2

稍作调整，它对我有用：

Sub create_jagged_array_of_tables()
    Dim big_arr As Variant, lil_arr As Variant, lr As Long, i As Long, j As Long, k As Long, ws As Worksheet
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Dim big_arr_size As Long

    ' Assumes you have groups of 2 per small array
    big_arr_size = WorksheetFunction.CountA(Range("A1:A" & lr)) / 2
    ReDim big_arr(1 To big_arr_size)
    k = 1
    For i = 1 To lr
        j = 1
        Do Until IsEmpty(Cells(i + j, 1))
            j = j + 1
        Loop
        If j > 1 Then
            lil_arr = Cells(i, 1).Resize(j).Value
            big_arr(k) = lil_arr ' changed `j` to `k`
            i = i + j
            k = k + 1
        Else
            MsgBox "row " & i & " is not part of an array"
        End If
    Next i
    For i = 1 To big_arr_size
        Set ws = Sheets.Add
        ws.Name = i
        ws.Cells(1, 1).Value = big_arr(i)(1, 1)
        ws.Cells(1, 2).Value = big_arr(i)(2, 1)
    Next i
End Sub

编辑：这是一种也许不同的方法。避免使用“小数组”设置为大数组的一部分。

Sub t()
Dim big_arr As Variant

Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Dim big_arr_size As Long

' Assumes you have groups of 2 per small array
big_arr_size = WorksheetFunction.CountA(Range("A1:A" & lr)) / 2
ReDim big_arr(1 To lr)
big_arr = Range("A1:A" & lr).Value

Dim i As Long, wsName As Long
Dim ws As Worksheet
wsName = LBound(big_arr)
For i = LBound(big_arr) To UBound(big_arr) - 1
    If Not IsEmpty(big_arr(i, 1)) And Not IsEmpty(big_arr(i + 1, 1)) Then
        Set ws = Sheets.Add
        ws.Name = wsName
        ws.Cells(1, 1).Value = big_arr(i, 1)
        ws.Cells(1, 2).Value = big_arr(i + 1, 1)
        wsName = wsName + 1
    End If
Next i

End Sub

Answer 3

该邮报已经有两个出色的答案（一个被接受），并且都具有独特的特征。但是，只想分享我的一些想法，因为我发现这篇帖子非常有趣。我只是尝试使用带标志的单循环简化锯齿状阵列的创建，并避免转置。可能请不要视为违反。

Sub create_jagged_array_of_tables()
    Dim big_arr() As Variant, lil_arr As Variant, lr As Long, i As Long, j As Long, k As Long, ws As Worksheet
    Dim Nw As Boolean, Xval As Variant
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    k = 0
    j = 0
    For i = 1 To lr
    Xval = Cells(i, 1).Value
        If IsEmpty(Xval) = False Then
            If Nw = False Then
            Nw = True
            k = k + 1
            j = 1
            ReDim lil_arr(1 To 1, 1 To j)
            lil_arr(1, j) = Xval
            ReDim Preserve big_arr(1 To k)
            big_arr(k) = lil_arr
            Else
            j = j + 1
            ReDim Preserve lil_arr(1 To 1, 1 To j)
            lil_arr(1, j) = Xval
            big_arr(k) = lil_arr
            End If
        Else
        Nw = False
        End If
    Next i

    For i = 1 To k
        Set ws = Sheets.Add
        ws.Name = i
        Cells(1, 1).Resize(1, UBound(big_arr(i), 2)).Value = big_arr(i)
    Next i
End Sub

如果不需要创建锯齿数组，并且唯一的目的是以所需的方式复制内容，则可以将其进一步简化为

Sub test1()
Dim lr As Long, Rng As Range, Area As Range, Cnt As Long, Arr As Variant
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A1:A" & lr)
Rng.AutoFilter Field:=1, Criteria1:="<>"
Set Rng = Rng.SpecialCells(xlCellTypeVisible)
 Cnt = 0
 For Each Area In Rng.Areas
 Cnt = Cnt + 1
 Set ws = Sheets.Add
 ws.Name = Cnt
 Arr = Area.Value
    If IsArray(Arr) Then
    ws.Cells(1, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)).Value = Application.Transpose(Arr)
    Else
    ws.Cells(1, 1).Value = Arr
    End If
 Next
Rng.AutoFilter Field:=1
End Sub

使用锯齿状阵列，将子阵列打印到工作表，VBA

3 个答案: