[算表] 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