如何将每个村每25行分到新表里？

Comet_95

我要把每个村的数据用VBA批量放到模板里，但是模版只支持25行，如何先把每个村数据多于25行的数据分成新的数据表？

chxw68

不用多此一举吧？可以直接用代码将数据分成25行一组写入模板的。

Comet_95

chxw68 发表于 2018-7-18 10:45
不用多此一举吧？可以直接用代码将数据分成25行一组写入模板的。

主要需要分村

chxw68

Comet_95 发表于 2018-7-18 11:16
主要需要分村

一个村一个工作簿文件，然后每25行一个工作表？

Comet_95

chxw68 发表于 2018-7-18 11:22
一个村一个工作簿文件，然后每25行一个工作表？

效果见附件

chxw68

Comet_95 发表于 2018-7-18 12:22
效果见附件

不好意思，问得有些多了。

LMY123

拆分成工作薄，第一个分薄装入每个村的第1-25行数据，第二个分薄装入每个村的第26-50行数据，第3个工作薄装入每个村的第51-75行数据

魂断蓝桥

Option Explicit

Sub A()
Dim cnn, rs As Object, Sql As String, arr, i%, s$, j%, m%, t%, brr, bt
Dim TM
TM = Timer
Set bt = Sheet1.[a1:S1]
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.Recordset")
cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
Sql = "select distinct CJQYMC from [标注$A1:a] where CJQYMC is not null "
arr = cnn.Execute(Sql).getrows
Sql = "select CJQYMC,count(*) from [标注$A1:a] where CJQYMC is not null group by  CJQYMC order by 2 desc"
brr = cnn.Execute(Sql).getrows
Application.DisplayAlerts = False
Application.ScreenUpdating = False
   For t = 1 To Int(brr(1, 0) / 25 + 0.99)
        j = j + 1
        Workbooks.Add
        bt.Copy [a1]
        For i = 0 To UBound(arr, 2)
            Sql = "select  *  from [标注$A1:s]  where CJQYMC='" & arr(0, i) & " '"
            rs.Open Sql, cnn, 1, 1
            rs.Move (j - 1) * 25
            m = [a9999].End(3).Row
            Range("a1").Offset(m, 0).CopyFromRecordset rs, 25
            rs.Close
        Next
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\分类后\" & (j - 1) * 25 + 1 & "-" & (j - 1) * 25 + 25 & ".xls", -4143
            ActiveWorkbook.Close 1
    Next
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "OK" & vbLf & Format(Timer - TM, "0.00秒")
End Sub

魂断蓝桥

LMY123 发表于 2018-7-18 15:54
拆分成工作薄，第一个分薄装入每个村的第1-25行数据，第二个分薄装入每个村的第26-50行数据，第3个工作薄装 ...

我觉得是这个意思。

需要考虑村计数是不同的，有的可能只有15条数据。