excel - 如何在VB6中选择具有多个工作表的Excel范围

Question

我有一个包含 70000 个元素的数组 (vb6)，我需要将该数组放置为 Excel 列。 由于每个 Excel 工作表的行数限制为 66k，我无法做到这一点。

我尝试选择包含多个工作表的范围，但出现错误。

Answer 1

更新了代码 #1

顶部代码已更新为

• 将示例 70K 数组的创建与与 Excel 的交互明确分开
• 使用两个新数组而不是一个来分隔示例 70k 数组(注意 ObjExcel.Transpose 不能用作缩减初始数组的第一个维度的解决方法，因为有更多X 中的记录数超过 65536 条)
• 在代码末尾将自动化 Excel 实例保持打开状态
• 测试是否存在至少两个 Excel 工作表(根据 Doug 的评论)

我添加了一个替代代码，将初始 70K 转储到工作表，然后直接从工作表设置 30K 和 40K，而不循环(请参阅更新的代码 #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

更新了代码 #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

原始代码

像这样的事情就可以了

1. 代码根据 A1:A6000 中的单元格创建一个包含 60,000 条记录的二维数组
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