Question

我有一个要用VBA填写的矩阵。循环使用一列中的信息来获取应为哪些列赋值。

我有矩阵行标题和列标题来辅助循环，如下所示：

    0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |... | 23
0
--
1
--
2
--
3
--
4
--
5
--
...
23

数字0-23代表一天中的小时数。 AA中的数据告诉我AB值中应粘贴多少列。

例如，如果Cells(2, 27)第2行第27列（AA）= 6，则AB列中的值应放在x第2行（小时0）。如果列迭代器的值大于25，则列迭代器应返回2并结束。

例如，如果在第23行的AA（avg_time_here）列中的值为6，则应该对Y列进行赋值，然后对B，C，D，E和F列进行赋值。问题是我不知道如何评估B-F列。我可以填写Y，但是一旦回到B列，我不知道如何。

到目前为止我所拥有的：

Option Explicit

Sub MatrixFill()

Dim avg_hrl_arr As Double    ' avgerage hourly arrivals
Dim avg_time_here As Integer ' avgerage time here
Dim hour_value As Integer    ' the value of the current hour
Dim y As Integer             ' row iterator for avg_time_here
Dim xCol As Integer          ' What column to go to
Dim x As Integer             ' for loop iterator
Dim LoopCount As Integer     ' How many times the loop has run
Dim NumCols As Integer       ' How many columns to fill out
Dim i As Integer             ' if statement for loop iterator

y = 21
LoopCount = 0

Worksheets("Sheet2").Select
Worksheets("Sheet2").Activate

Do While Cells(y, 27) <> ""
    hour_value = Cells(y, 1)
    avg_time_here = Cells(y, 27)
    NumCols = avg_time_here
    avg_hrl_arr = Cells(y, 28)
    'MsgBox ("The hour = " & hour_value & vbNewLine & "There are on average " & avg_hrl_arr & " hourly arrivals." & vbNewLine & "Avg time here = " & avg_time_here & " hours.")
    xCol = (avg_time_here + hour_value + 1)
    ' loop through columns
    Debug.Print "Hour Value Initialized to: " & hour_value
    Debug.Print "Average Time Here Initialized to: " & avg_time_here
    Debug.Print "NumCols Initialized to: " & NumCols
    Debug.Print "Average Hourly Arrivals Initialized to: " & avg_hrl_arr
    Debug.Print "xCol Initialized to: " & xCol
    For x = (hour_value + 2) To xCol
        Debug.Print "X is currently " & x
        If x > 25 Then
            Debug.Print "NumCols is currently " & NumCols
            i = 2
            Do While NumCols > 0
                Cells(y, i) = avg_hrl_arr
                NumCols = NumCols - 1
                Debug.Print "NumCols is now " & NumCols
                i = i + 1
            Loop
            GoTo NextYValue
        End If
        Cells(y, x) = avg_hrl_arr
        LoopCount = LoopCount + 1
        NumCols = NumCols - 1
        Debug.Print "Y = " & y
        Debug.Print "LoopCount = " & LoopCount
        Debug.Print "NumCols = " & NumCols & " left"
    Next x

NextYValue： y = y + 1 LoopCount = 0 循环

结束子

样本数据：

| avg_time_here | avg_hrl_arr 
|---------------|-------------
|7              | 4.47        
|7              | 3.54        
|6              | 3.11        
|6              | 2.55        
|7              | 2.40        
|7              | 2.34        
|6              | 3.15        
|6              | 4.68        
|6              | 6.44
|5              | 8.63
|6              | 10.00
|6              | 10.60
|6              | 10.68
|6              | 10.31
|6              | 9.92
|6              | 10.05
|6              | 9.89
|6              | 9.98
|6              | 10.23
|6              | 10.00
|6              | 9.37
|6              | 8.41
|6              | 7.32
|6              | 5.82

我希望我的输出看起来像图片：

Answer 1

这是我的方法。

将数据转换为结构化的Excel表，如下所示：

根据需要定制代码：

Sub MatrixFill()

    ' Declare objects
    Dim matrixSheet As Worksheet
    Dim dataTable As ListObject
    Dim dataCell As Range

    ' Declare other variables
    Dim matrixSheetName As String
    Dim sheetDataName As String
    Dim dataTableName As String
    Dim matrixInitialCell As String
    Dim cellCounter As Integer
    Dim columnOffset As Integer
    Dim columnResize As Integer

    Dim avg_hrl_arr As Double    ' avgerage hourly arrivals
    Dim avg_time_here As Integer ' avgerage time here
    Dim hour_value As Integer    ' the value of the current hour

    ' Initialize objects
    matrixSheetName = "Sheet2"
    Set matrixSheet = ThisWorkbook.Worksheets(matrixSheetName)

    dataTableName = "TableData"
    sheetDataName = "Sheet1"
    Set dataTable = ThisWorkbook.Worksheets(sheetDataName).ListObjects(dataTableName)

    ' Clear initial range
    matrixSheet.Range("B2:B25").Clear

    matrixInitialCell = "A1"

    ' Loop through each data cell
    For Each dataCell In dataTable.DataBodyRange.Columns(1).Cells

        cellCounter = cellCounter + 1

        ' Get data values
        avg_time_here = dataCell.Value
        avg_hrl_arr = dataCell.Offset(0, 1).Value

        ' Resize if there are more than 24 columns
        If (cellCounter + avg_time_here - 1) > 24 Then
            columnResize = (cellCounter + avg_time_here - 1) - 24
        Else
            columnResize = 0
        End If

        ' Fill matrix
        matrixSheet.Range(matrixInitialCell).Offset(cellCounter, cellCounter).Resize(1, avg_time_here - columnResize).Value = avg_hrl_arr

        ' Fill from begining the ones that are left
        If columnResize > 0 Then
            matrixSheet.Range(matrixInitialCell).Offset(cellCounter, 1).Resize(1, columnResize).Value = avg_hrl_arr
        End If

    Next dataCell

End Sub

围绕Excel VBA填充对角矩阵

1 个答案: