Запишите массив на лист и повторите его n раз - PullRequest
Новая
       17

Запишите массив на лист и повторите его n раз

0 голосов
/ 18 ноября 2018

Я работаю над кодом, в котором я хочу записать 2 массива (назначенных на «Листе ввода») на лист «Выходных данных» n раз, то есть, в частности, 2 раза в цикле. Я хочу использовать массивы, потому что диапазон идентификаторов и их имен может измениться (может быть намного больше). Для начала на простом примере (с небольшим количеством данных) массивам присваиваются соотв. к данным на листе «Входные данные»: enter image description here

Эти 2 массива должны быть записаны в лист «Вывод» n раз, т.е. Они должны быть записаны один раз, а затем снова в цикле, то есть 2 раза. Я хочу сделать это в цикле, чтобы дать ему гибкость написания в будущем, например. 3, 4, n раз. В этом примере я делаю это 2 раза. Перед каждым записанным массивом должен быть написан заголовок «Заголовок», а в конце написанного массива должен быть написан текст «Всего», , поэтому это мой желаемый результат: enter image description here

Мой код работает только для записи 2-х массивов в первый раз, но он не записывает эти 2-х массивов во 2-й раз. Вместо этого я получаю что-то еще, что не так: enter image description here

Это мой код: 

Sub Write1()
Dim r As Long
Dim c As Long
Dim Start_Row As Long
Dim End_Row As Long
Dim main As Integer
Dim lngRowCount As Long
Dim w_Output As Worksheet
Dim w1 As Worksheet

Dim intLastRow As Integer
Const RowStart As Integer = 3
Const ColumnID As Integer = 1
Const Column_Desc As Integer = 3

Dim arrID() As Variant
Dim arrDesc() As Variant

With ThisWorkbook
    Set w1 = .Sheets("Input")
    Set w_Output = .Sheets("Output")
End With

'***********************************
'arrays
With w1
    intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    'IntLastCol = .Cells(4, Columns.Count).End(xlToLeft).Column
    arrID = .Range(.Cells(RowStart, ColumnID), .Cells(intLastRow, ColumnID))
    arrDesc = .Range(.Cells(RowStart, Column_Desc), .Cells(intLastRow, Column_Desc))

'******************************************

main = 1
End_Row = 2  'this is the 2nd iteration to write arrays

For Start_Row = 1 To End_Row
    w_Output.Cells(main, 3) = "Title"

    main = main + 1

    For r = 1 To UBound(arrID, 1)

        If Len(arrID(r, 1)) > 0 Then

            'Write
                w_Output.Cells(r + 1, 3) = arrID(r, 1)
                w_Output.Cells(r + 1, 4) = arrDesc(r, 1)

        End If


    main = main + 1

    w_Output.Cells(main, 3) = "Total "

    Next r

    main = main + 4
Next Start_Row

End With

MsgBox "Done", vbInformation
End Sub

Кто-нибудь знает, что я делаю неправильно в своем цикле, чтобы заставить его работать?

1 Ответ

0 голосов
/ 20 ноября 2018

Я понял это, оказывается, я просто должен был использовать «main» в качестве строки для записи на лист, а не «r», который используется для массивов - это часть кода, где массивы написаны на листе. 

Sub Write1()
Dim r As Long
Dim c As Long
Dim d As Long
Dim Start_Row As Long
Dim End_Row As Long
Dim main As Integer
Dim lngRowCount As Long
Dim w_Output As Worksheet
Dim w1 As Worksheet

Dim intLastRow As Integer
Dim IntLastCol As Integer
Const RowStart As Integer = 3
Const ColumnID As Integer = 1
Const Column_Desc As Integer = 3

Dim arrID() As Variant
Dim arrDesc() As Variant

With ThisWorkbook
    Set w1 = .Sheets("Input")
    Set w_Output = .Sheets("Output")
End With

'***********************************
'arrays
With w1
    intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    arrID = .Range(.Cells(RowStart, ColumnID), .Cells(intLastRow, ColumnID))
    arrDesc = .Range(.Cells(RowStart, Column_Desc), .Cells(intLastRow, Column_Desc))

'******************************************

main = 1
End_Row = 2

For Start_Row = 1 To End_Row
    w_Output.Cells(main, 3) = "Title"

    main = main + 1

    For r = 1 To UBound(arrID, 1)

        If Len(arrID(r, 1)) > 0 Then

            'Write
                w_Output.Cells(main, 3) = arrID(r, 1)
                w_Output.Cells(main, 4) = arrDesc(r, 1)

        End If


    main = main + 1

    Next r

    w_Output.Cells(main, 3) = "Total "
    main = main + 4

Next Start_Row

End With

MsgBox "Done", vbInformation
End Sub

Работает отлично.

...