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

使用字段集合，因为无论如何你都要循环遍历记录集。

"type"="LOGO"

你可以在循环中使用2个索引器变量：一个用于转到下一个工作表，另一个用于跟踪行循环。

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

Answer 2

CopyFromRecordset没有能力做你想做的事。

您可能希望使用OFFSET-FETCH将SQL分解为多个部分，如下所示：http://www.dofactory.com/sql/order-by-offset-fetch

Answer 3

此方法将数据从记录集

获取为Variant

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

使用vba我从db中获取5000条记录，如何循环将evrey 1000记录粘贴到新工作表中？

3 个答案: