Nhờ code VBA để đọc dữ liệu từ file dạng text và xử lý trong workbook.

[cavang02]

Xin chào mọi người và nhờ giúp code VBA để xử lý :
- Đọc file text vào sheet 1 (lấy dữ liệu từ dòng thứ 4 của file text)
- Chuyển toàn bộ dữ liệu từ sheet 1 sang sheet 2 theo các cột
File Text như sau có tên là baikt.txt

Truy van tu du lieu tren máy chu theo ngay @ Cac ma so hien thi theo tat ca cac code trong type 31/01/2022 1 32A 32A 1 VA334 7268 G 2 32A 32A 1 VA334 7269 P 01/02/2022 1 32A 32A 1 VA334 113 J 2 32A 32A 1 VA334 1276 J 3 32A 32A 1 VA334 1277 J 4 32A 32A 1 VA334 1186 J 5 32A 32A 1 VA334 1187 J 6 32A 32A 2 VA335 1342 J

Sheet 1 và Sheet 2

31/01/2022 1 32A 32A 1 VA334 7268 G 2 32A 32A 1 VA334 7269 P 1/2/2022​ 1 32A 32A 1 VA334 113 J 2 32A 32A 1 VA334 1276 J 3 32A 32A 1 VA334 1277 J 4 32A 32A 1 VA334 1186 J 5 32A 32A 1 VA334 1187 J 6 32A 32A 2 VA335 1342 J

Ngay Code So hieu Loai (1) (2) (3) (4) 31/01/2022 VA334 268 G 31/01/2022 VA334 269 P 1/2/2022 VA334 13 J 1/2/2022 VA334 276 J 1/2/2022 VA334 277 J 1/2/2022 VA334 186 J 1/2/2022 VA334 187 J 1/2/2022 VA335 342 J

 

[PTHhn]

Thành thực mà nói, nếu bạn trả cho tôi 20 triệu để code, với yêu cầu này tôi cũng không dám nhận.
1. Bạn nên sử dụng hình ảnh minh họa vào trong bài viết.
Cách upload ảnh lên diễn đàn bạn tham khảo ở đây.

Bạn cần đăng nhập để thấy link

2. Bạn nên cung cấp file demo, có thể upload lên google drive rồi để public kéo link về diễn đàn.

 

[jd86]

cavang02 thử code dưới này xem có ok ko nhé

Bạn cần đăng nhập để thấy đa phương tiện

Bạn cần đăng nhập để thấy đa phương tiện

Bạn cần đăng nhập để thấy đa phương tiện

Sub test()
    Sheets("Sheet1").Columns("A:A").ClearContents
    Sheets("Sheet2").Range("A3:D11").ClearContents
    Dim file_path As String: Dim i As Long: Dim str As String
    file_path = Sheets("CODE___").Cells(1, 2).Text
    i = 1
    Open file_path For Input As #1
       Do Until EOF(1)
        Line Input #1, str
            If i > 4 Then
                 Sheets("Sheet1").Cells(i - 4, 1).Value = str
            End If
        i = i + 1
       Loop
    Close #1
    '
    Dim j As Long: Dim k As Long
    i = 1
    k = 3
    Do While Sheets("Sheet1").Cells(i, 1).Text <> ""
        If InStr(Sheets("Sheet1").Cells(i, 1).Text, "/") > 0 Then
            j = i + 1
            Do While Sheets("Sheet1").Cells(j, 1).Text <> "" And InStr(Sheets("Sheet1").Cells(j, 1).Text, "/") = 0
                Dim arr() As String
                arr = Split(Sheets("Sheet1").Cells(j, 1).Text)
                Sheets("Sheet2").Cells(k, 1).Value = Sheets("Sheet1").Cells(i, 1).Text
                Sheets("Sheet2").Cells(k, 2).Value = arr(4)
                Sheets("Sheet2").Cells(k, 3).Value = Right(arr(5), 3)
                Sheets("Sheet2").Cells(k, 4).Value = arr(6)
                k = k + 1
                j = j + 1
            Loop
        End If
    i = i + 1
    Loop
    MsgBox ("OK")
End Sub