填写一组基于不同单元格的数组（24 x 20） [英] Fill a set array (24 x 20) which changes based on different cells

问题描述

我敢肯定我是在反思这个，但我相信Excel可以处理它。我试图采取各种数字（最多9个不同的数字，从单元格1,1开始，填写第1行（1,24）上的24列，然后填写1列（2,24），然后向后填充在第一个240个单元格中以S的形式显示
我可以将数字9（A1）作为我的第一个变量，所以1,1到1,9将是5XL（但是记住我有24列）所以我的下一个变量将从（B1）接收为6，所以接下来的六个单元格将是4XL，现在我可以达到1,15，我还需要改变结果数组，希望你获取图片

然后这个宏将​​产生这些resu在E2中显示的列：AB20

  Sub PopulateTable（）
 
 Dim ws As Worksheet 
 Dim vSourceData As Variant 
 Dim aResults（）As String 
 Dim bBackwards As Boolean，bFull As Boolean 
 Dim lRowIndex As Long，lColIndex As Long 
 Dim i As Long，j As Long 
 
设置ws = ActiveWorkbook.ActiveSheet 
带有ws.Range（A2：B& ws.Cells（ws.Rows.Count，A）。End（xlUp））
如果.Row< 2然后退出子'没有数据
 vSourceData = .Value 
结束
 ReDim aResults（1到20，1到24）
 
 lRowIndex = 1 
 lColIndex = 1 
 bBackwards = False 
 bFull = False 
 
对于i = 1对于UBound（vSourceData，1）
对于j = 1对于vSourceData（i， 1）
 aResults（lRowIndex，lColIndex）= vSourceData（i，2）
如果bBackwards则lColIndex = lColIndex  -  1 Else lColIndex = lColIndex + 1 
如果lColIndex = 0然后
 lRowIndex = lRowIndex + 1 
 lColIndex = 1 
 bBackwards =不是bBackwards 
 ElseIf lColIndex = UBound（aResults，2）+ 1然后
 lRowIndex = lRowIndex + 1 
 lColIndex = UBound（aResults，2）
 bBackwards =否bBackwards 
结束If 
如果lRowIndex> UBound（aResults，1）然后bFull = True'结果数组中没有更多的空间
如果bFull然后退出
下一步j 
如果bFull然后退出
下一个i 
 
使用ws.Range（E2）。调整大小（UBound（aResults，1），UBound（aResults，2））
 .ClearContents'清除以前的结果（如果有）
。 Value = aResults'输出结果
结束
 
 End Sub 
  

I'm sure I'm overthinking this, but I believe Excel can handle it. I'm trying to take various numbers (up to 9 different numbers and begin at cell 1,1 and fill across 24 columns on row 1 (1,24) and then down 1 row (2,24) and then fill backwards and subsequently in an "S" shape through out the first 240 cells. I may have the number 9 (A1) as my first variable, so 1,1 through 1,9 would be 5XL (but remember I have 24 columns) so, my next variable would then take over from (B1) as 6, so the next six cells would be 4XL. Now I'm up to 1,15. I also need to be able to change the results array. I hope you get the picture. Screen Shot of array

解决方案

Assuming you have a data setup like this:

Then this macro will produce those results shown in E2:AB20

Sub PopulateTable()

    Dim ws As Worksheet
    Dim vSourceData As Variant
    Dim aResults() As String
    Dim bBackwards As Boolean, bFull As Boolean
    Dim lRowIndex As Long, lColIndex As Long
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.ActiveSheet
    With ws.Range("A2:B" & ws.Cells(ws.Rows.Count, "A").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        vSourceData = .Value
    End With
    ReDim aResults(1 To 20, 1 To 24)

    lRowIndex = 1
    lColIndex = 1
    bBackwards = False
    bFull = False

    For i = 1 To UBound(vSourceData, 1)
        For j = 1 To vSourceData(i, 1)
            aResults(lRowIndex, lColIndex) = vSourceData(i, 2)
            If bBackwards Then lColIndex = lColIndex - 1 Else lColIndex = lColIndex + 1
            If lColIndex = 0 Then
                lRowIndex = lRowIndex + 1
                lColIndex = 1
                bBackwards = Not bBackwards
            ElseIf lColIndex = UBound(aResults, 2) + 1 Then
                lRowIndex = lRowIndex + 1
                lColIndex = UBound(aResults, 2)
                bBackwards = Not bBackwards
            End If
            If lRowIndex > UBound(aResults, 1) Then bFull = True    'No more room in results array
            If bFull Then Exit For
        Next j
        If bFull Then Exit For
    Next i

    With ws.Range("E2").Resize(UBound(aResults, 1), UBound(aResults, 2))
        .ClearContents      'Clear previous results (if any)
        .Value = aResults   'Output results
    End With

End Sub

这篇关于填写一组基于不同单元格的数组（24 x 20）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！