Заполнение диагональной матрицы с переносом вокруг Excel VBA

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 следует поместитьв строке 2 (час 0) х раз.Если итератор столбца достигает значения больше 25, то итератор столбца должен вернуться к 2 и завершить его.

Например, если в строке 23 в столбце AA есть значение 6 (avg_time_here), тогдастолбец Y должен получить значение, а затем столбцы B, C, D, E и F должны получить значение.Проблема в том, что я не знаю, как оценивать столбцы BF.Я могу заполнить Y, но как только мне придется вернуться к столбцу BI, я не знаю, как.

Что у меня есть:

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 Loop

End Sub

Пример данных:

| 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