[問題] Excel VBA程式精簡?

看板Office作者snecma (每天心發現)時間13年前 (2012/09/15 06:07)推噓0(0推 0噓 1→)

留言1則, 1人參與討論串1/1

(若是和其他不同軟體互動之問題請記得一併填寫) 軟體:2007 版本:NA Dear 大大們小弟有個VBA的程序如下: Sub macroexample() Application.ScreenUpdating = False 'Clean sheet1 (Datas)' ThisWorkbook.Sheets(1).Range("A6:LZ9999").Clear 'Files directory' ChDir "C:\Documents and Settings\USER\桌面\test" 'MODIFY Dim monfichier As String Dim n As Long monfichier = Dir("*.txt") n = 11 'MODIFY 'Import CMM datas' While monfichier <> "" 'while excel can open the TXT files one by one 'it opens one txt file Workbooks.OpenText Filename:=monfichier _ , Origin:=936, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1)), TrailingMinusNumbers:=True 'and copy and paste the data in the excel table Workbooks(monfichier).Sheets(1).Range("A1").Copy Destination:=ThisWorkbook.Sheets(1).Range("C" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B17").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B19").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B21").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B23").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B25").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B27").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY 'next CMM report' n = n + 1 monfichier = Dir() ActiveWorkbook.Close Wend End Sub 其中在以下Range("B17")到("B27")是有規律性的增加兩列,小弟的程式要怎樣精簡呢不然如果到("B57"),小弟就要一直複製貼上改數據到("B57") Workbooks(monfichier).Sheets(1).Range("A1").Copy Destination:=ThisWorkbook.Sheets(1).Range("C" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B17").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B19").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B21").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B23").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B25").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY Workbooks(monfichier).Sheets(1).Range("B27").Copy Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 114.47.220.185