标签：VBA
下面分享在vbaexpress.com中收集的几段代码，用于合并文本文件并将其放置在当前工作表中。
下面的代码用于将单个文本文件导入当前工作表：
代码语言：javascript复制Sub ImportText()
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
fileFilterPattern = "Text Files (*.txt; *.csv; *.log),*.txt;*.csv;*.log"
fileToOpen = Application.GetOpenFilename(fileFilterPattern)
Workbooks.OpenText _
Filename:=fileToOpen, _
StartRow:=2, _
DataType:=xlDelimited, _
Semicolon:=True
Set wbTextImport = ActiveWorkbook
Set wsMaster = ThisWorkbook.Worksheets("original file")
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy wsMaster.Range("A3")
wbTextImport.Close False
End Sub注意，代码从文本文件第2行导入，放置在当前工作表单元格A3开始的区域；文本文本中的数据以分号分隔。
下面的代码可以选择多个文件文件并将它们合并导入当前工作表：
代码语言：javascript复制Public Sub ImportText2()
Dim fd As FileDialog
Dim var
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "选择要导入的文本文件"
With .Filters
.Clear
.Add "Text Files", "*.txt;*.csv;*.log", 1
End With
If .Show Then
For Each var In .SelectedItems
Call Import_Textfile(var)
Next
End If
End With
End Sub
Private Sub Import_Textfile(ByVal tFile As String)
Debug.Print tFile
Dim first_row As Long, last_row As Long
Dim content As String, var As Variant, v As Variant
Dim cols As Integer
Dim iFile As Integer
Dim i As Long, j As Long
Dim sht As Worksheet
Set sht = ActiveSheet
first_row = 3
last_row = LastRow(sht.Range("a1")) 1
iFile = FreeFile
Open tFile For Input As #iFile
Line Input #iFile, content
While Not EOF(iFile)
i = i 1
If i > 1 Then
var = Split(content, ";")
cols = 6
If UBound(var) < 6 Then
cols = UBound(var)
End If
For j = 0 To cols Step 1
'检查文本文件第一列的格式并转换为合适的日期格式
If j = 0 Then
v = Split(var(j), "/")
sht.Cells(last_row, j 1) = DateSerial(v(2), v(1), v(0))
Else
sht.Cells(last_row, j 1) = var(j)
End If
Next
last_row = last_row 1
End If
Line Input #iFile, content
Wend
If i > 1 Then
var = Split(content, ";")
cols = 6
If UBound(var) < 6 Then
cols = UBound(var)
End If
For j = 0 To cols Step 1
If j = 0 Then
v = Split(var(j), "/")
sht.Cells(last_row, j 1) = DateSerial(v(2), v(1), v(0))
Else
sht.Cells(last_row, j 1) = var(j)
End If
Next
End If
Close #iFile
sht.Range("H3:J3").Select
Selection.Copy
sht.Range("H4:J" & last_row).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,
_SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
sht.Range("A1").Select
End Sub
Public Function LastRow(ByRef Rng As Range)
With Rng.Parent
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Function欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。
