0

ORASQL クエリを、ブックご​​とに指定された数のエントリを持つ複数のワークブックに分割しようとしています。問題があれば、Office 2010 を使用しています。以下のものを使用して (前の行カウントの例から) カウントを取得し、それを使用してシートを分割する必要があると思います。

With ThisWorkbook.Sheets("Sheet1")
    recct = .Range("A3", .Range("A" & .Rows.Count).End(xlUp)).Rows.Count
End With
  1. 私はまだVBAの経験がなく、ここからどこに行くべきかわかりません。
  2. RecordCount などを使用すると、より良い方法があるのではないかと思います。

詳細を追加して明確にするには:

  • VBA 内で SQL クエリを実行します。
  • 1 つのワークブックの 1 つのシートに、9 つの異なる列 (AI) を持つ ~176k 行のリストを返します。
  • 176k 行から一度に 30k の情報を別のワークブックにコピーし、特定のパスに保存したいと考えています。

ここに私の orcale 接続情報を除いた全体があります

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
4

1 に答える 1

1

これを行うには2つの方法があります

  1. プル マクロから変更して、複数のワークブックに入力し、さまざまな場所に保存するようにします。
  2. データをコピーして新しいワークブックに配置する後処理マクロを作成する

方法 2 から始めて、後でプル マクロに統合できます。方法 2 は次のようになります。

Sub Test()
    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.Name = "NewBook" & i & ".xlsx"
        wbk.Sheets(1).Cells(1, 1).Resize(UBound(aryData, 1), UBound(aryData, 2)) = aryData
        'save and close workbook
        wbk.SaveAs Filename:="C:\temp\" & wbk.Name
        wbk.Close
    Next
End Sub

これが役立つかどうか教えてください！

于 2013-07-22T20:05:32.360 に答える