[已解决]再求助雪舞子：老师：您好！ ...

水木

再求助雪舞子：老师：您好！还有个问题要请您赐教！也就是《数据》工作簿的保存格式是.rar (27.31 KB, 下载次数: 6)

2016-1-16 20:23 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

雪舞子

2016-1-16 21:16

1. Sub test()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     On Error Resume Next
   
5.     Set th = ThisWorkbook
   
6.     Set wk = Workbooks.Open(th.Path & "" & "数据")
   
7.     With wk
   
8.         For Each sh In .Worksheets
   
9.             If Not th.Sheets(sh.Name) Is Nothing And th.Sheets.Count > 1 Then
   
10.                 th.Sheets(sh.Name).Delete
    
11.             Else
    
12.                 th.Sheets(sh.Name).Name = "temp"
    
13.             End If
    
14.             .Sheets(sh.Name).Copy After:=th.Sheets(th.Sheets.Count)
    
15.             If sh.Name <> "目录" Then
    
16.                 With th.Sheets(sh.Name)
    
17.                     .Rows("2:3").Delete
    
18.                     .Columns("G:I").Delete
    
19.                     .Range("g2") = "备注"
    
20.                 End With
    
21.             End If
    
22.         Next
    
23.         .Close False
    
24.     End With
    
25.     If Not th.Sheets("temp") Is Nothing And th.Sheets.Count > 1 Then
    
26.         th.Sheets("temp").Delete
    
27.     End If
    
28.     Application.ScreenUpdating = True
    
29.     Application.DisplayAlerts = True
    
30. End Sub

复制代码

复制.rar (18.53 KB, 下载次数: 12)

2016-1-16 21:16 上传

点击文件名下载附件

跳转到最佳答案楼层

雪舞子

1. Sub test()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     On Error Resume Next
   
5.     Set th = ThisWorkbook
   
6.     Set wk = Workbooks.Open(th.Path & "" & "数据")
   
7.     With wk
   
8.         For Each sh In .Worksheets
   
9.             If Not th.Sheets(sh.Name) Is Nothing And th.Sheets.Count > 1 Then
   
10.                 th.Sheets(sh.Name).Delete
    
11.             Else
    
12.                 th.Sheets(sh.Name).Name = "temp"
    
13.             End If
    
14.             .Sheets(sh.Name).Copy After:=th.Sheets(th.Sheets.Count)
    
15.             If sh.Name <> "目录" Then
    
16.                 With th.Sheets(sh.Name)
    
17.                     .Rows("2:3").Delete
    
18.                     .Columns("G:I").Delete
    
19.                     .Range("g2") = "备注"
    
20.                 End With
    
21.             End If
    
22.         Next
    
23.         .Close False
    
24.     End With
    
25.     If Not th.Sheets("temp") Is Nothing And th.Sheets.Count > 1 Then
    
26.         th.Sheets("temp").Delete
    
27.     End If
    
28.     Application.ScreenUpdating = True
    
29.     Application.DisplayAlerts = True
    
30. End Sub

复制代码

复制.rar (18.53 KB, 下载次数: 12)

2016-1-16 21:16 上传

点击文件名下载附件