Как выбрать диапазон Excel в VB6, который имеет несколько листов

Question

У меня есть массив из 70000 элементов (vb6), и мне нужно разместить массив как столбец Excel.Поскольку для каждого листа Excel предел строки составляет 66 КБ, я не могу этого сделать.

Я попытался выбрать диапазон из нескольких листов, но получаю ошибку.

Answer 1

Updated Code #1

Код вверху обновлен до

• четко отделить создание образца массива 70К от взаимодействия с Excel
• для использования двух новых массивов для разделения образца массива 70k, а не одного (примечание ObjExcel.Transpose нельзя использовать в качестве обходного пути для повторного получения первого измерения исходного массива, поскольку в X содержится более 65536 записей )
• оставить автоматизированный экземпляр Excel открытым в конце кода
• проверка на наличие как минимум двух листов Excel (согласно комментарию Дуга)

Я добавил альтернативный код, который выводит исходные 70 КБ на лист, а затем устанавливает 30 КБ и 40 КБ непосредственно из листа без циклов (см. Updated Code #2)

     Sub SplicedArray2()
    Dim objExcel As Object
    Dim objWB As Object
    Dim X(1 To 70000, 1 To 1) As String
    Dim Y()
    Dim Z()
    Dim lngRow As Long
    Dim lngRow2 As Long
    Dim lngStart As Long

    'create intial 70K record array
    For lngRow = 1 To UBound(X, 1)
        X(lngRow, 1) = "I am record " & lngRow
    Next

    'records split size
    lngStart = 30000

    Set objExcel = CreateObject("excel.application")
    'creats a new excel file. You may wish to open an existing one instead
    Set objWB = objExcel.Workbooks.Add

    ReDim Y(1 To UBound(X, 1) - lngStart, 1 To 1)
    'Place records 30001 to 70000 from original array to second array
    For lngRow2 = 1 To UBound(Y, 1)
        Y(lngRow2, 1) = X(lngRow2 + lngStart, 1)
    Next lngRow2

    ReDim Z(1 To lngStart, 1 To 1)
    'Place records 1 to 30000 from original array to third array
    For lngRow2 = 1 To UBound(Z, 1)
        Z(lngRow2, 1) = X(lngRow2, 1)
    Next lngRow2

    'Test for presence of second sheet, add it if there is only one sheet
    If objWB.Sheets.Count < 2 Then objWB.Sheets.Add
    'Dump first set of records to sheet 1
    objWB.Sheets(1).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y
    ' Dump second set of records to sheet 2
    objWB.Sheets(2).[a1].Resize(UBound(Z, 1), UBound(Z, 2)) = Z
    objExcel.Visible = True

    'close file (unsaved)
    ' objWB.Close False
    ' objExcel.Quit
    ' Set objExcel = Nothing
    End Sub

Updated Code #2

    Sub OtherWay()
   'Works only in xl 07/10 if more than 65536 rows are needed
    Dim objExcel As Object
    Dim objWB As Object
    Dim objws As Object
    Dim lngRow As Long
    Dim lngStart As Long
    Dim X(1 To 70000, 1 To 1) As String
    Dim Y()
    Dim Z()

    Set objExcel = CreateObject("excel.application")
    'Add a single sheet workbook
    Set objWB = objExcel.Workbooks.Add(1)
    Set objws = objWB.Sheets.Add

    For lngRow = 1 To UBound(X, 1)
        X(lngRow, 1) = "I am record " & lngRow
    Next

    'records split size
    lngStart = 30000

    With objws.[a1]
        .Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
        Y = .Resize(lngStart, UBound(X, 2)).Value2
        Z = .Offset(lngStart, 0).Resize(UBound(X, 1) - lngStart, UBound(X, 2)).Value2
        .Parent.Cells.ClearContents
    End With

    objWB.Sheets(1).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y
    objWB.Sheets(2).[a1].Resize(UBound(Z, 1), UBound(Z, 2)) = Z
    objExcel.Visible = True

    'close file (unsaved)
    ' objWB.Close False
    ' objExcel.Quit
    ' Set objExcel = Nothing
    End Sub

Original Code

Что-то вроде этого сделает это

1. Код создает двумерный массив записей 60000 из ячеек в A1: A6000
2. Затем он использует второй массив для хранения второй половины (от 30001 до 60000) записей первого массива
3. Первая половина записей в исходном массиве (от 1 до 30000) выгружается на первый лист (остальные записи просто игнорируются, поскольку диапазон Excel составляет половину размера массива)
4. Второй массив сбрасывается на второй лист

Приведенный ниже код использует INT() для обработки массивов с нечетными записями
т.е. будет сброшено 60001 записей

• запись от 1 до 30000 на лист1
• записи с 30001 по 60001 на лист 2

[Обновить код для отображения автоматизации Excel]

    Sub SplicedArray()
    Dim objExcel As Object
    Dim objWB As Object
    Dim X()
    Dim Y()
    Dim lngRow As Long
    Dim lngStart As Long

    Set objExcel = CreateObject("excel.application")
    'creats a new excel file. You may wish to open an existing one instead
    Set objWB = objExcel.Workbooks.Add

    'create 60000*1 array from column A
    X = objWB.Sheets(1).Range("A1:A60000").Value2

    'determine if second array needs X/2+1 records for an odd sized array
     If UBound(X, 1) Mod 2 <> 0 Then
        ReDim Y(1 To Int(UBound(X, 1) / 2) + 1, 1 To 1)
    Else
        ReDim Y(1 To Int(UBound(X, 1) / 2), 1 To 1)
    End If

    'loop from 30001 to 60000
    For lngRow = Int(UBound(X, 1) / 2) + 1 To UBound(X, 1)
        ' put value of row 30001 column 1 into row 1 column 1 of second array
        ' ......
        ' put value of row 60000 column 1 inro row 30000 column 1 of second array
        Y(lngRow - Int(UBound(X, 1) / 2), 1) = X(lngRow, 1)
    Next lngRow
    ' Dump first half of records from orginal array to sheet 1
    objWB.Sheets(1).[a1].Resize(Int(UBound(X, 1) / 2), UBound(X, 2)) = X
    ' Dump second half of records from new array to sheet 2
    objWB.Sheets(2).[a1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y

    'close file (unsaved)
    objWB.Close False
    objExcel.Quit
    Set objExcel = Nothing
    End Sub