[算表] Excel VBA 請益!

作者: snecma (每天心發現)   2019-10-17 21:44:49
軟體:Excel
版本:2016
請教以下的VBA是把資料夾內的TXT檔案一個一個打開,並抓取特定位置的數值,現在TXT
檔案要改成EXCEL檔案,下面要修改那個字元呢,謝謝.
Sub macroexample()
Application.ScreenUpdating = False
'Clean sheet1 (Datas)'
ThisWorkbook.Sheets(1).Range("B16:LZ9999").Clear
'Files directory'
ChDrive "C" 'MODIFY
ChDir "C:\Users\chpc\Desktop\611_VBA TEST\611_CMM" 'MODIFY
Dim monfichier As String
Dim n As Long
Dim i As Long
monfichier = Dir("*.txt")
n = 16 '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("D2").Copy
Destination:=ThisWorkbook.Sheets(1).Range("D" & n) 'MODIFY
Workbooks(monfichier).Sheets(1).Range("H3").Copy
Destination:=ThisWorkbook.Sheets(1).Range("A" & n) 'MODIFY
Workbooks(monfichier).Sheets(1).Range("E3").Copy
Destination:=ThisWorkbook.Sheets(1).Range("B" & n) 'MODIFY
Workbooks(monfichier).Sheets(1).Range("F3").Copy
Destination:=ThisWorkbook.Sheets(1).Range("C" & n) 'MODIFY
For j = 101 To 119 Step 2 'MODIFY
i = i + 1 'MODIFY
Workbooks(monfichier).Sheets(1).Range("B" & j).Copy
Destination:=ThisWorkbook.Sheets(1).Cells(n, "E")(1, i) 'MODIFY
Next
'next CMM report'
n = n + 1: i = 0
monfichier = Dir()
ActiveWorkbook.Close
Wend
End Sub
作者: soyoso (我是耀宗)   2019-10-17 22:44:00
如果要以monfichier的檔名來當excel檔案檔名的話monfichier=dir()上面activeworkbook.saveas檔名replace monfichier "txt"為"xlsx"(如果格式為這個的話),fileformat如不是的話,副檔名再自行調整

Links booklink

Contact Us: admin [ a t ] ucptt.com