是否将ADODB记录集拆分为Excel工作表

Question

我有一个小型宏程序，可以从SQL到Excel工作表中提取近200万行数据。但问题是，每个工作表最多只能包含1048576行，所以它会剪切我的数据。

我想知道是否有办法在将ADODB记录集粘贴到Excel之前将其拆分。

以下是我将数据从SQL提取到Excel的代码：

With oRecordSet
.ActiveConnection = oDBConnection
.Source = MySql
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
Sheets("Data)").Range("A2").CopyFromRecordset oRecordSet

感谢你们的帮助。提前谢谢。

Answer 1

您可以查询数据并应用一些过滤逻辑。

您可以尝试分隔和管理多达1亿行。

或者，使用文件拆分工具(像这样或这样(。

您也可以尝试VBA解决方案。

步骤1

另存为，扩展名为.xlsm(启用宏(的工作簿

步骤2

1. 按ALT+F11打开Visual Basic

2. 插入>模块并将下面的代码粘贴到右侧(来自Sub……End Sub(

Sub SplitTxt_01()
Const HelperFile As String = "ABCD" '<<< temp. helper text file Name
Const N As Long = 700000  '<<< split each txt in N rows, CHANGE
Dim myPath
myPath = "c:Folder1Folder2" '<<< folder path, CHANGE
Dim myFile
myFile = "Data File.TXT" '<<< your text file. CHANGE txt file name as needed
Dim WB As Workbook, myWB As Workbook
Set myWB = ThisWorkbook
Dim myWS As Worksheet
Dim t As Long, r As Long
Dim myStr
Application.ScreenUpdating = False
'split text file in separate text files
myFile = Dir(myPath & myFile)
Open myPath & myFile For Input As #1
t = 1
r = 1
Do While Not EOF(1)
Line Input #1, myStr
If r > N Then
t = t + 1
r = 1
End If
Open myPath & HelperFile & t & ".txt" For Append As #2
Print #2, myStr
Close #2
r = r + 1
Loop
Close #1
'copy txt files in separate sheets
For i = t To 1 Step -1
Workbooks.OpenText Filename:=myPath & HelperFile & i & ".txt", DataType:=xlDelimited, Tab:=True
Set WB = ActiveWorkbook
Set rng = ActiveSheet.UsedRange
Set myWS = myWB.Sheets.Add
myWS.Name = HelperFile & i
rng.Copy myWS.Cells(1, 1)
WB.Close False
Next
myWB.Save
'Delete helper txt files
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fldr = Fso.GetFolder(myPath)
For Each Filename In Fldr.Files
If Filename Like "*" & HelperFile & "*" Then Filename.Delete
Next
Application.ScreenUpdating = True
End Sub

3. 按ALT+Q关闭Visual Basic

最后，我认为可能是时候升级到Python或R.了