老师们好，如何进行数据拆分放入到Excel的工作簿的A列中，谢谢！

homewin

老师们好，我想把文件中的数据（test）读入到result的几个工作表中的A列，如何用VBA来实现；                                                                               
PS:因为数据的行数超过每个工作表的行数，所有要读入到几个工作表中（工作表的数目要根据数据大小来确定）                                                                               
最后，谢谢老师们的帮忙！                                                                               

chxw68

呵呵，你这个问题确实很有挑战性！主要是原来从没有遇到过这类问题，今天查了很多资料，终于搞定了！从中也学到了很多东西。

1. Sub test()
   
2.   Dim ws As Worksheet
   
3.   Dim cn As ADODB.Connection
   
4.   Dim rs As ADODB.Recordset
   
5.   Dim cnstring As String
   
6.   Dim SQL As String
   
7.   Application.DisplayAlerts = False
   
8.   For Each ws In Worksheets
   
9.     If ws.Name <> "Sheet1" Then
   
10.       ws.Delete
    
11.     End If
    
12.   Next
    
13.   Set cn = New Connection
    
14.   cnstring = "Provider=MicroSoft.JET.OLEDB.4.0;Extended Properties='text;FMT=DELIMITED';Data Source=k:\pls help"
    
15.   cn.ConnectionString = cnstring
    
16.   cn.Open
    
17.   Set rs = New Recordset
    
18.   SQL = "select  * from test.txt"
    
19.   rs.Open SQL, cn, 3, 1
    
20.   jls = rs.RecordCount
    
21.   i = 1
    
22.   Do Until rs.EOF
    
23.     If i > 1 Then
    
24.       Set ws = ThisWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
25.       ws.Name = "Sheet" & i
    
26.     Else
    
27.       Set ws = Worksheets("sheet1")
    
28.       ws.Range("a1") = rs.Fields(0).Name
    
29.     End If
    
30.     sl = IIf(jls - rs.AbsolutePosition + 1 >= 65535, 65535, jls - rs.AbsolutePosition + 1)
    
31.     arr = rs.GetRows(sl, 0)
    
32.     ws.Range("a2").Resize(sl, 1) = Application.Transpose(arr)
    
33.     i = i + 1
    
34.   Loop
    
35.   cn.Close
    
36.   Set ws = Nothing
    
37. End Sub
    

复制代码

homewin

chxw68 发表于 2012-8-31 00:05
呵呵，你这个问题确实很有挑战性！主要是原来从没有遇到过这类问题，今天查了很多资料，终于搞定了！从中也 ...

我也想了很久，由于水平低，解决不了，谢谢chxw68 ！

Zamyi

1. Sub test()
   
2. t = Timer
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. For i = Sheets.Count To 2 Step -1
   
6.   Sheets(i).Delete
   
7. Next
   
8. f = ThisWorkbook.Path & "\test"
   
9. s = CreateObject("scripting.FileSystemObject").OpenTextFile(f).ReadAll
   
10. With CreateObject("VBSCRIPT.REGEXP")
    
11.   .Global = True
    
12.   .Pattern = "^([^\n]+\n){65536}"
    
13.   Do
    
14.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
15.       .SetText s
    
16.       .PutInClipboard
    
17.       ActiveSheet.Paste Cells(1, 1)
    
18.     End With
    
19.     If .test(s) Then s = .Replace(s, "") Else Exit Do
    
20.     Sheets.Add after:=Sheets(Sheets.Count)
    
21.   Loop
    
22. End With
    
23. Application.ScreenUpdating = True
    
24. Application.DisplayAlerts = True
    
25. MsgBox Timer - t
    
26. End Sub

复制代码

Zamyi

指定每页行数：

chxw68

我是按有文本文件里有标题行编写的，你的文件里没有标题行，我又修改了一下。

LMY123

超过65536行，分页显示