如何选择具有多个工作表的vb6中的excel范围

Question

我有一个70000个元素（vb6）的数组，我需要将该数组作为excel列。 由于每个Excel表格都有66k的行数限制，所以我无法做到这一点。

我试着选择多个工作表的范围，但我得到错误。

Answer 1

Updated Code #1

在顶部的代码已被更新以

• 清楚地从交互与Excel
• 使用两个新的阵列分离分离样品70K阵列的创建样本70k数组而不是一个（注意ObjExcel.Transpose不能用作解决初始数组的第一维的解决方法，因为X中有超过65536条记录）
• 离开所述自动Excel实例在码的末尾打开
• 试验中的真皮休闲两个Excel片的存在（根据Doug的评论）

我已经添加转储初始的替换码70K到工作表，然后从工作表设置30K和40K的情况下直接循环（参见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. 该代码创建从在A1中的细胞中的60000记录2D阵列：A6000
2. 然后，它使用的第二阵列存储第一个阵列记录的后半部分（30001至60000）
3. 第一个将原始数组中的一半记录（1到30000）转储到第一张纸上（因为Excel范围是数组大小的一半，所以其余记录将被忽略）
4. 第二个数组转储到第二张纸

下面的代码使用INT()具有奇数记录处理阵列
即60001记录将被转储

• 记录1至30000至30001 SHEET1
• 记录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