vbaを使用してデータベースから5000レコードをフェッチしました。新しいワークシートにevrey 1000レコードを貼り付けるループを作成する方法は？

Question

私は1000のレコードを取り出して新しいシートに値を貼り付けて、結果としてブックに5枚のシートがあるようにループする方法がわかりません。 本当にありがとうございます。 ありがとう！

Sub text_analysis() 
Dim conn As ADODB.Connection 
Dim rs As ADODB.Recordset 
Dim sConnString As String 
Dim rsstring As String 
Dim cmd As ADODB.Command 
Dim NewWorkbook As Workbook 
Set NewWorkbook = Workbooks.Add 

Set cmd = New ADODB.Command 
Set conn = New ADODB.Connection 

sConnString = "Provider=SQLOLEDB;Data Source=localhost\SQLEXPRESS;" & _ 
       "Initial Catalog=MDM-FINAL;" & _ 
       "Integrated Security=SSPI;" 

Set rs = New ADODB.Recordset 

conn.Open sConnString 
rsstring = "exec text_analysis;" 
rs.Open rsstring, sConnString 

NewWorkbook.Activate 
Do Until rs.EOF 
Worksheets("sheet1").Range("A2").CopyFromRecordset rs, MaxRows:=100000 
ActiveSheet.Name = "Text Analysis" 
Range("A1").Value = "SAP Code 1" 
Range("B1").Value = "SAP Desc 1" 
Range("C1").Value = "SAP Code 2" 
Range("D1").Value = "SAP Desc 2" 
Range("E1").Value = "Diff Count" 
Range("F1").Value = "Diff Value" 
Range("G1").Value = "Similar %" 
Range("H1").Value = "Similar Partial %" 
Range("I1").Value = "Similar Sort %" 
Range("J1").Value = "Similar Set %" 
Loop 

rs.Close 
conn.Close 

End Sub 

Answer 1

とにかくレコードセットをループしているので、フィールドコレクションを使用してください。

Do Until rs.EOF 
Range("A1").Value = rs.Fields("SAP Code 1") 
... 
Loop 

ループ内に2つのインデクサ変数を使用できます.1つは次のシートに移動し、もう1つは行ループを追跡します。

Dim i as integer 
Dim j as integer 
Dim ws as worksheet 

j = 1 
i = 1 
Set ws = Worksheets(j) 
Do Until rs.EOF 
    i = i + 1 
    If i % 1000 = 0 then 
     i = 1 
     j = j + 1 
     set ws = Worksheets(j) 
    End if 
    ws.range("A" & i).value = rs.Fields("SAP Code 1") 
    .... 
Loop 

Answer 2

CopyFromRecordsetには、やりたいことをする能力がありません。

あなたはOFFSET-FETCHここに示すように使用して粉々にあなたのSQLを壊すに見てみたいことがあります：http://www.dofactory.com/sql/order-by-offset-fetch

Answer 3

この方法は実際にレコードセット

Sub text_analysis() 
Dim conn As ADODB.Connection 
Dim rs As ADODB.Recordset 
Dim sConnString As String 
Dim rsstring As String 
Dim cmd As ADODB.Command 
Dim NewWorkbook As Workbook 
Set NewWorkbook = Workbooks.Add 

Set cmd = New ADODB.Command 
Set conn = New ADODB.Connection 

sConnString = "Provider=SQLOLEDB;Data Source=localhost\SQLEXPRESS;" & _ 
       "Initial Catalog=MDM-FINAL;" & _ 
       "Integrated Security=SSPI;" 

Set rs = New ADODB.Recordset 

conn.Open sConnString 
rsstring = "exec text_analysis;" 
rs.Open rsstring, sConnString 

'get data as Variant from recordset 
    Dim R As Long, m As Long, c As Integer 
    Dim i As Long, j As Integer 
    Dim vR, Ws As Worksheet 
    vR = rs.getRows 
    R = UBound(vR, 2) 
    c = UBound(vR, 1) 
    For m = 0 To R Step 1000 
     ReDim vResult(1 To 1000, 1 To c + 1) 
     For i = 0 To 999 
      If i + m > R Then Exit For 
      For j = 0 To c 
       vResult(i + 1, j + 1) = vR(j, i + m) 
      Next j 
     Next i 
     Set Ws = Sheets.Add(after:=Sheets(Sheets.Count)) 
     With Ws 
      For i = 0 To rs.Fields.Count - 1 
       .Cells(1, i + 1).Value = rs.Fields(i).Name 
      Next 
      Range("a2").Resize(1000, c + 1) = vResult 
     End With 
    Next m 


rs.Close 
conn.Close 

End Sub