我有70000个元素的数组（vb6），我需要将数组作为excel列。 由于每个excel表的行限制为66k，我无法做到。
我尝试使用多个工作表选择范围但我收到错误。
答案 0 :(得分：3)
<强> Updated Code #1
顶部的代码已更新为
ObjExcel.Transpose不能用作解决初始数组的第一个维度的解决方法，因为{中有超过65536个记录{1}}）我添加了一个替代代码，将初始70K转储到工作表，然后直接从工作表设置30K和40K而不循环（参见 X ）
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来处理具有奇数记录的数组
即将丢弃60001条记录
[更新显示Excel自动化的代码]
INT()