按要求导出各乡镇名单

cherga · 发表于 2024-7-2 10:58

导出原则
1.按照现建档县市分开建立新的工作铺（A列-J列）

2.导出I列【县级已通知】（J列空白以及未迁出的），对方拒绝迁出不导出来，此外J列“已接收”也不导出来
3.工作簿命名：现建档县市+导出条数，如：第一县2条数据
4.导出该工作表，所有数据去公式，去有效性或下拉选项

洋务德雷 · 发表于 2024-7-2 11:14

没有看明白

蓝桥玄霜 · 发表于 2024-7-2 11:37

分表的例子：

limonet · 发表于 2024-7-2 11:47

关键字：into

limonet · 发表于 2024-7-2 11:48

Sub limonet()
Dim Cn As Object, StrSQL$, Rst As Object, CS$, i%
Set Cn = CreateObject("Adodb.Connection")
Set Rst = CreateObject("adodb.recordset")
CS = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 xml;Data Source="
Cn.Open CS & ThisWorkbook.FullName
StrSQL = "Select 现建档县市,Count(*) From [Sheet1$A:J] Where 现建档县市<>'' And 县级处理情况<>'对方拒绝迁出' And 申请单位反馈情况<>'已接收' Group By 现建档县市"
Arr = Cn.Execute(StrSQL).GetRows
For i = 0 To UBound(Arr, 2)
      StrSQL = "[Sheet1$A:J] Where 现建档县市='" & Arr(0, i) & "' And 县级处理情况<>'对方拒绝迁出' And 申请单位反馈情况<>'已接收'"
      Cn.Close: Cn.Open CS & ThisWorkbook.Path & "\" & Arr(0, i) & Arr(1, i) & "条数据.xlsx"
      Cn.Execute ("Select * Into Sheet1 From [Excel 12.0;Database=" & ThisWorkbook.FullName & "]." & StrSQL)
Next i
End Sub

Qs18 · 发表于 2024-7-2 14:36

Sub qs() '2024/7/2
Dim arr, i, j, brr, xwb As Workbook
With Sheet1
arr = .Range("a1:j" & .Cells(Rows.Count, 1).End(3).Row)
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 1 To UBound(arr)
      If InStr(arr(i, 9), "已通知") Then
         If InStr(arr(i, 10), "未迁出") Or arr(i, 10) = Empty Then
            m = m + 1
            For j = 1 To UBound(arr, 2)
                  brr(m, j) = arr(i, j)
                  brr(m, 5) = "'" & arr(i, 5)
            Next
         End If

      End If

Next
End With
Set xwb = Workbooks.Add
xwb.Sheets(1).Range("a1").Resize(1, UBound(arr, 2)) = Application.Index(arr, 1, 0)
xwb.Sheets(1).Range("a2").Resize(m, UBound(arr, 2)) = brr
      With xwb.Sheets(1).Range("a1").Resize(m + 1, UBound(brr, 2))
         .Borders.LineStyle = 1
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .EntireColumn.AutoFit
      End With
End Sub

Qs18 · 发表于 2024-7-2 14:42

试一下..............

lizhipei78 · 发表于 2024-7-2 17:13

参与一下

档案申请迁入登记表.rar (23.6 KB, 下载次数: 4)

lizhipei78 · 发表于 2024-7-2 17:15

写的稍微长了点

lizhipei78 · 发表于 2024-7-2 17:22

档案申请迁入登记表.rar (24.55 KB, 下载次数: 6)

		自动登录	找回密码
密码			免费注册

[求助] 按要求导出各乡镇名单

评分

评分