如何select具有多个工作表的VB6中的Excel范围

我有一个数组70000元素（VB6），我需要把数组作为一个Excel列。 由于每个Excel表有66k行限制，我不能这样做。

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

Answer 1

Updated Code #1

顶部的代码已经更新为

• 清楚地将样本70K数组的创build从与Excel的交互中分离出来
• 使用两个新的数组来分隔样本70k数组而不是一个（注意ObjExcel.Transpose不能用作回避初始数组的第一维的解决方法，因为X中有超过65536条logging）
• 在代码的末尾打开自动化的Excel实例
• testing出现在两个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：A6000中的单元格创build了一个60,000个logging的二维数组
2. 然后使用第二个数组来存储第一个数组logging的后半部分（30001到60000）
3. 原始数组中的logging的前半部分（1到30000）被转储到第一个工作表（由于Excel范围是数组大小的一半，所以其余logging将被忽略）
4. 第二个arrays被转储到第二张纸上

下面的代码使用INT()来处理奇数logging的数组
即60001logging将被倾倒

• logging1到30000到sheet1
• logging30001到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