求助大神！！提取关键字的行数据，另存为一个表格。

jy00607350

求助大神，根据F列省份，提取对应省份的内容。另存为单独表页，最好是单独表格。

目前我笨方法 筛选省份，复制内容 然后粘贴到新建表格。

jiangxiaoyun

vba也可以走这个套路。

jy00607350

jiangxiaoyun 发表于 2018-3-6 14:01
vba也可以走这个套路。

嗯，就是想求教VBA~

jiangxiaoyun

2018.zip (1 MB, 下载次数: 64)

2018-3-6 14:18 上传

点击文件名下载附件

jy00607350

jiangxiaoyun 发表于 2018-3-6 14:18

感谢大神，我打算好好学学VBA了。 另问个小问题，把每个表页另存成单独的表格有什么快捷方法么

jiangxiaoyun

jy00607350 发表于 2018-3-6 14:25
感谢大神，我打算好好学学VBA了。 另问个小问题，把每个表页另存成单独的表格有什么快捷方法么

复制数据表格--新建excel工作簿--粘贴--关闭保存。
如此重复。自行参考下列代码修改。
Sub zz()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set d = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        d(ar(i, 3)) = ""
    Next
    For Each k In d.keys
        Sheet1.Copy
        With ActiveWorkbook.Sheets(1)
            .Range("$A$1:$U$" & UBound(ar)).AutoFilter Field:=3, Criteria1:= _
                "<>" & k, Operator:=xlAnd'筛选不符合条件的数据
            .UsedRange.Offset(1).Delete'删除数据
            .Range("$A$1").AutoFilter'取消筛选
        End With
        ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & k & ".xlsx"
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

jy00607350

jiangxiaoyun 发表于 2018-3-6 14:29
复制数据表格--新建excel工作簿--粘贴--关闭保存。
如此重复。自行参考下列代码修改。
Sub zz()

感谢！ 学习啦！

jy00607350

jiangxiaoyun 发表于 2018-3-6 14:29
复制数据表格--新建excel工作簿--粘贴--关闭保存。
如此重复。自行参考下列代码修改。
Sub zz()

还得麻烦一下~ 因为刚接触VBA 自己参考下面的代码试了几次还是没有成功.大神给个完整版的好不，就是根据省份拆分保存成单独表格。 万分感谢

jy00607350

还得麻烦一下~ 因为刚接触VBA 自己参考下面的代码试了几次还是没有成功.大神给个完整版的好不，就是根据省份拆分保存成单独表格。 万分感谢