Создать несколько листов для выгрузки данных массива - PullRequest
0 голосов
/ 26 февраля 2019

Пожалуйста, обратитесь к приведенному ниже коду, который необходимо настроить, когда я сталкиваюсь с трудностями.

Существует массив m3a, в котором содержится большой объем данных, которые выгружаются в новый рабочий лист после завершения кода.Если данные превышают количество макс. Строк в Excel (1048576), он добавляет верхние 1048575 данных в новый массив m4a и выводит их.Я хотел бы знать, что если данные превышают, как можно создать несколько листов (два листа, три листа ... и т. Д. В зависимости от количества строк в массиве. Пожалуйста, помогите мне настроить этот фрагмент кода

iLines = 3
startCalc = True
If startCalc Then
  Worksheets.Add After:=Worksheets(Worksheets.Count)
   Set sh = ActiveSheet
   If UBound(m3a, 1) <= Rows.Count Then
    sh.Range("A1").Resize(cnt, iLines + 1).Value = m3a
   Else
     ReDim m4a(1 To 1048575, 1 To iLines + 1)

       For i = 1 To 1048575
         For j = 1 To iLines + 1

            m4a(i, j) = m3a(i, j)
         Next j
       Next i
       sh.Range("A1").Resize(1048575, iLines + 1).Value = m4a
   End If
End If

1 Ответ

0 голосов
/ 26 февраля 2019

Может быть, этот пример поможет.Я использую меньший массив из 105 элементов и перемещаю 10 строк за раз, так что получается 10 листов с 10 строками и 1 лист с 5 строками.Вам не нужно заполнять свой массив, так как он у вас уже есть.Миллионы строк парализуют мою систему работы.Удачи ...

Редактировать: обновлено для 2D-массива.

Sub x()

Dim v(1 To 105, 1 To 2), i As Long, j As Long, ws As Worksheet, n As Long

n = 10 'number of rows transferred to each sheet

For i = LBound(v, 1) To UBound(v, 1) 'populating array just for this example
    v(i, 1) = i
    v(i, 2) = i * i
Next i

Do
    If UBound(v, 1) - j <= n Then n = UBound(v, 1) - j
    Set ws = Worksheets.Add
    ws.Range("A1").Resize(n, 2).Value = Application.Index(v, Evaluate("row(" & j + 1 & ":" & n + j & ")"), Array(1, 2))
    j = j + n
    If j >= UBound(v, 1) Then Exit Sub
Loop

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...