Xin giúp đỡ về thêm dữ liệu file txt vào excel (1 người xem)

[khitamdao]

- Mình có 1 file excel (như tệp đính kèm)
sheets "Quan trac" ở cột A chứa tên file
các sheets còn lại là DB_1, DB_2 ... đến DB_9
mình viết code để cập nhật dữ liệu từ file txt vào các sheets DB_*
* trong trường hợp này là ThaiNguyen vào sheets DB_1; DinhHoa vào sheets DB_2 ... lần lượt như thế
khi mình chạy code nó không hoạt động
mong các bạn giúp đỡ

(sau khi cập nhập dữ liệu sẽ như trong hình)
code:

Sub getSL()
Dim tfile, tsheet, duongdan, tram As String
For i = 4 To 12
For k = 1 To 9
tram = Worksheets("Quan trac").Cells(i, 1)
If IsEmpty(tram) = False Then
tfile = Worksheets("Quan trac").Cells(i, 7)
duongdan = ThisWorkbook.Path & "\Data\" & tfile
tsheet = "DB_" & k

Sheets(tsheet).Select

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;duongdan & .txt", Destination:=Range("$A$1"))
.Name = tfile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(15, 15, 15, 15, 15, 15, 15, 15)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Else
End If
Next k
Next i

End Sub

 

[khitamdao]

Mình đã giải quyết xong

code đã sửa như sau:


Sub getSL()
Dim tfile, tsheet, duongdan, tram As String
For i = 4 To 33
k = i - 3
tram = Worksheets("Quan trac").Cells(i, 7)
If tram <> "" Then
tfile = Worksheets("Quan trac").Cells(i, 7)
duongdan = ThisWorkbook.Path & "\Data\" & tfile & ".txt"
tsheet = "DB_" & k
Sheets(tsheet).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + duongdan, Destination:=Range("$A$1"))
.Name = tfile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(10, 12, 13, 12, 14, 15, 14, 14)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Else
End If
Next i
End Sub

Bài đã được tự động gộp: 4/6/19

- Bây giờ mình có một vấn đề, nếu không tồn tại sheet DB_10 thì tạo sheet đó
- Bạn nào cho mình xin code giải quyết vấn đề này với
thanks

 

[ducdoom]

Chào bạn,
bạn thử code này xem sao nhá


Sub Create_sheet_if_not_exist()

Dim DB_10 As Worksheet: Set DB_10 = Nothing
Dim xsheet As Worksheet

For Each xsheet In ThisWorkbook.Worksheets
If xsheet.Name = "DB_10" Then
Set DB_10 = xsheet
DB_10.Name = "DB_10"
Exit For
End If
Next

If DB_10 Is Nothing Then
Set DB_10 = ThisWorkbook.Worksheets.Add()
DB_10.Name = "DB_10"
End If

End Sub