[發問] 簡化程式

本帖最後由 luke 於 2012-5-13 13:07 編輯

各位大大

小弟用錄製了巨集修改如下
Sub CC()
Set fd = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\" & "TT.txt"
With Workbooks.Open(FS).Sheets("TT")
   FT.Sheets("Sheet2").Columns("A:B") = .Columns("A:B").Value
.Parent.Close False
End With
Application.ScreenUpdating = True

Set fd = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\TEST\" & "TT.txt"
With Workbooks.Open(FS).Sheets("TT")
   FT.Sheets("Sheet2").Columns("G:H") = .Columns("A:B").Value
.Parent.Close False
End With
Application.ScreenUpdating = True

Set fd = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\" & "UU.csv"
With Workbooks.Open(FS).Sheets("UU")
   FT.Sheets("Sheet2").Columns("C") = .Columns("A").Value
.Parent.Close False
End With
Application.ScreenUpdating = True
End Sub
Sub DD()
Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\" & "TT.txt"
With Workbooks.Open(FS).Sheets("TT")
   FT.Sheets("Sheet2").Columns("D:E").Copy .Columns("A:B")
.Parent.Close savechanges:=True
End With
Application.ScreenUpdating = True

Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\TEST\" & "TT.txt"
With Workbooks.Open(FS).Sheets("TT")
   FT.Sheets("Sheet2").Columns("G:H").Copy .Columns("A:B")
.Parent.Close savechanges:=True
End With
Application.ScreenUpdating = True
sheet2.[f1:f5] = [c1:c5].Value
Range("F6").Select
ActiveCell.FormulaR1C1 = "=""Count=""&COUNT(R[-5]C[-2]:RC[-2])"
Range("F7").Select
ActiveCell.FormulaR1C1 = "=""Lan""&R[-6]C[-2]&""=""&R[-6]C[-1]"
Range("F7").Select
Selection.Copy
Range("F8:F9").Select
ActiveSheet.Paste
Range("F6:F9").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
Application.ScreenUpdating = False
Set FT = ActiveWorkbook
FS = "D:\TEST\TEST20\" & "UU.csv"
With Workbooks.Open(FS).Sheets("UU")
   FT.Sheets("Sheet2").Columns("F").Copy .Columns("A")
.Parent.Close savechanges:=True
End With
Application.ScreenUpdating = True
End Sub

煩請先進大大指導簡化程式

樓主熱帖

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

2^#

發表於 2012-5-13 19:27 | 顯示全部帖子

回復 2# play9091

回覆卓大大

小弟對語法不太了解, 目前只會用拼裝方式把相關程式湊在一起, 因此不會用array語法

謝謝你的建議

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

3^#

發表於 2012-5-13 22:47 | 顯示全部帖子

回復 4# play9091

回覆大大

重新整理後如下說明:

Sheet1表A:B欄匯入D:\TT.txt, C欄匯入D:\UU.csv, G:H欄匯入D:\123\TT.txt.

完成後將A:C欄移至D:F欄, G:H欄固定不動
修改後再分別將D:E欄存至D:\TT.txt,F欄存至D:\UU.csv, G:H欄存至D:\123\TT.txt

請問與法如何修改?

TEST20A.rar (13.46 KB)

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

4^#

發表於 2012-5-13 23:57 | 顯示全部帖子

本帖最後由 luke 於 2012-5-14 09:47 編輯

回復 6# Hsieh

回覆H超版

說明見附檔紅字部分

煩請先進大大指導

TEST20B.rar (17.93 KB)

TOP