我正在尝试将我的 ORASQL 查询拆分为多个工作簿,每本书都有指定数量的条目。如果这很重要,我正在使用 Office 2010。我想我应该使用下面的内容(来自上一个关于行数的示例)来获取计数,然后我可以使用它来拆分工作表。
With ThisWorkbook.Sheets("Sheet1")
recct = .Range("A3", .Range("A" & .Rows.Count).End(xlUp)).Rows.Count
End With
- 我不确定从这里去哪里,因为我还没有 VBA 经验,而且
- 我认为 RecordCount 或类似的东西可能有更好的方法。
添加细节和澄清:
- 我在 VBA 中运行 sql 查询。
- 它将包含 9 个不同列 (AI) 的约 176k 行列表返回到一个工作簿的一张表中。
- 我想将 176k 行中的信息(一次 30k)复制到单独的工作簿中,并将它们保存到特定路径。
这是整个事情,减去我的 orcal 连接信息
Sub pull_paper_claims()
Dim ym As Variant
Dim sql As String
Dim recct As Long
ym = Range("B2").Value
Set oConOracle = CreateObject("ADODB.Connection")
Set oRsOracle = CreateObject("ADODB.Recordset")
sql = "select unique payor_name, payor_addr1, payor_city, payor_zip, payor_state, taxid, pat_account, act_id, payor_id from lisa.cc_data_" & ym & " where claim_status='p' and payor_id!='cpapr'and payor_id!='hpapr' and payor_id!='xpapr'"
'oracle connection
oConOracle.Open "my conection information"
Set oRsOracle = oConOracle.Execute(sql)
'clear it up first
Range("A3", "K200000").ClearContents
Range("A3").CopyFromRecordset oRsOracle
With ThisWorkbook.Sheets("Sheet1")
recct = .Range("A3", .Range("A" & .Rows.Count).End(xlUp)).Rows.Count
End With
Range("A1").Value = recct
'close the statement
oConOracle.Close
Set oRsOracle = Nothing
Set oConOracle = Nothing
'ActiveWorkbook.SaveAs Filename:="D:\important\job_stats_" & Format(end_date, "yyyymmdd") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub
添加以回答您的问题。
我从字面上复制了你所拥有的东西到一个新的潜艇中并且几乎没有改变。
Sub Create_new_wb()
Const numRow = 30000 'constant for number of rows in each copy
Dim lRow As Long 'variable to contain the last row information
Dim lCol As Long 'variable to contain the last column information
Dim wbk As Workbook
Dim i As Long
Dim aryData() As Variant
'find lrow and lcolumn in data sheet
lRow = ThisWorkbook.Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = ThisWorkbook.Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
'loop through number of times required to part all data
For i = 1 To Application.RoundUp(lRow / numRow)
'determine size of aray and put data into array
If lRow > i * numRow Then
ReDim aryData(1 To i * numRow, 1 To lCol)
aryData = ThisWorkbook.Sheets("Sheet1").Cells((numRow * (i - 1)) + 1, 1).Resize(numRow, lCol)
Else
ReDim aryData(1 To lRow - (numRow * i))
aryData = ThisWorkbook.Sheets("Sheet1").Cells((numRow * (i - 1)) + 1, 1).Resize(lRow - (numRow * i), lCol)
End If
'add new workbook and paste data
Set wbk = Workbooks.Add()
wbk.Sheets(1).Cells(1, 1).Resize(UBound(aryData, 1), UBound(aryData, 2)) = aryData
'save and close workbook
wbk.SaveAs Filename:="C:\temp\" & "NewBook" & i & ".xlsx"
wbk.Close
Next
End Sub