→ soyoso: 如果要以monfichier的檔名來當excel檔案檔名的話 10/17 22:44
→ soyoso: monfichier=dir()上面activeworkbook.saveas 10/17 22:45
→ soyoso: 檔名replace monfichier "txt"為"xlsx"(如果格式為這個的 10/17 22:46
→ soyoso: 話)，fileformat如不是的話，副檔名再自行調整 10/17 22:48
軟體: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
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 180.217.145.101 (臺灣)
※ 文章網址: https://www.ptt.cc/bbs/Office/M.1571319891.A.6D0.html