Chuyển đổi dữ liệu thô về dạng bảng (Table) (1 người xem)

[Đình Phán]

Chào các anh,chị

Em có dữ liệu thô được bố trí tại sheet Goc, em muốn chuyển về dạng bảng như tại sheet KetQua để tiện import vào Access.
Mong các anh chị giúp đỡ code VBA để làm được điều trên.

(Code VBA của excel để xử lý trên excel trước rồi import vào Access hoặc Code VBA của Access để xử lý sau khi đã import vào Access đều được ạ)
Em cảm ơn!

 

[minhminh27]

Chào các anh,chị

Em có dữ liệu thô được bố trí tại sheet Goc, em muốn chuyển về dạng bảng như tại sheet KetQua để tiện import vào Access.
Mong các anh chị giúp đỡ code VBA để làm được điều trên.

(Code VBA của excel để xử lý trên excel trước rồi import vào Access hoặc Code VBA của Access để xử lý sau khi đã import vào Access đều được ạ)
Em cảm ơn!

Anh Đình Phán làm được bài này chưa ạ cho em xin code với.
Em xem qua file gửi thì nhìn cột A thì em chưa biết phân biệt khi nào là Cửa hàng, hay là Nhân Viên, hay Mặt hàng.
Chắc dữ liệu gốc không phải chữ bắt đầu tại các ô ở cột A là Cửa hàng, hay là Nhân Viên, hay Mặt hàng đúng không?


Còn xem về mặt dữ liệu thì có vẻ kết quả anh đang muốn là dữ liệu thô, dev code viết ra file báo cáo cho sheet gốc trên thì phải.

 

[HUONGHCKT]

Chào các anh,chị

Em có dữ liệu thô được bố trí tại sheet Goc, em muốn chuyển về dạng bảng như tại sheet KetQua để tiện import vào Access.
Mong các anh chị giúp đỡ code VBA để làm được điều trên.

(Code VBA của excel để xử lý trên excel trước rồi import vào Access hoặc Code VBA của Access để xử lý sau khi đã import vào Access đều được ạ)
Em cảm ơn!

Trong khi chờ các giải pháp khác tốt hơn, hãy thử tham khảo Code củ khoai, rau má tàu sau.

Option Explicit

Sub ABC()
Dim i&, j&, Lr&, t&, k&, R&
Dim Arr(), KQ()
Dim TenCH$, TenNV$, TenMH$
Dim Rng As Range
With Sheets("Goc")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A2:E" & Lr).Value
R = UBound(Arr)
End With
ReDim KQ(1 To R, 1 To 7)
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> Empty Then
        If Arr(i, 1) Like "C?a hàng*" Then
            t = t + 1
            KQ(t, 1) = Arr(i, 1)
            TenCH = Arr(i, 1)
        ElseIf Trim(Arr(i, 1)) Like "Nhân viên*" Then
            KQ(t, 1) = TenCH
            KQ(t, 2) = Trim(Arr(i, 1))
            TenNV = Trim(Arr(i, 1))
            t = t + 1
        ElseIf Arr(i, 1) Like "M?t hàng*" Then
            KQ(t, 1) = TenCH
            KQ(t, 2) = TenNV
            KQ(t, 3) = Arr(i, 1)
            TenMH = Arr(i, 1)
            If Arr(i, 3) <> Empty And Not IsNumeric(Arr(i + 1, 1)) Then
                KQ(t, 4) = Arr(i, 3)
                KQ(t, 5) = Arr(i, 3)
            End If
            t = t + 1:
        ElseIf IsNumeric(Arr(i, 1)) Then
            KQ(t, 1) = TenCH
            KQ(t, 2) = TenNV
            KQ(t, 3) = TenMH
            For j = 2 To 5
                KQ(t, j + 2) = Arr(i, j)
            Next j
            t = t + 1
        End If
    End If
Next i
With Sheets("KetQua")
    If t Then
        .Range("A2").Resize(Rows.Count - 2, 7).ClearContents
        .Range("A2").Resize(Rows.Count - 2, 7).Borders.LineStyle = xlNone
        .Range("A2").Resize(t, 7) = KQ
        .Range("A2").Resize(t, 7).Borders.LineStyle = 1
    End If
    For i = 2 To 2 + t
        If .Range("E" & i) = Empty Then
            If Rng Is Nothing Then
                Set Rng = .Range("A" & i).Resize(, 7)
            Else
                Set Rng = Union(Rng, .Range("A" & i).Resize(, 7))
            End If
        End If
    Next i
Rng.Delete Shift:=xlUp
End With

End Sub

Hy vọng đúng ý.

 

[thuytrangbp28]

Trong khi chờ các giải pháp khác tốt hơn, hãy thử tham khảo Code củ khoai, rau má tàu sau.

Sao thấy nó chạy chậm thế nhỉ

 

[hoangtuaotrang_hp_vn]

ChatGPT hân hạnh tài trợ những dòng code này
(mượn code của anh HUONGHCKT ạ, nếu có gì không phải anh bỏ quá cho em nhé)

Option Explicit

Sub ABC()
    Dim i As Long, j As Long, Lr As Long, t As Long, R As Long
    Dim Arr(), KQ()
    Dim TenCH As String, TenNV As String, TenMH As String
    Dim wsGoc As Worksheet, wsKQ As Worksheet
    Dim rngDel As Range

    Set wsGoc = Sheets("Goc")
    Set wsKQ = Sheets("KetQua")

    Lr = wsGoc.Cells(wsGoc.Rows.Count, 1).End(xlUp).Row
    If Lr < 2 Then Exit Sub

    Arr = wsGoc.Range("A2:E" & Lr).Value
    R = UBound(Arr)
    ReDim KQ(1 To R, 1 To 7)

    For i = 1 To R
        If Not IsEmpty(Arr(i, 1)) Then
            Select Case True
                Case Arr(i, 1) Like "C?a hàng*"
                    t = t + 1
                    KQ(t, 1) = Arr(i, 1)
                    TenCH = Arr(i, 1)

                Case Trim(Arr(i, 1)) Like "Nhân viên*"
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = Trim(Arr(i, 1))
                    TenNV = Trim(Arr(i, 1))
                    t = t + 1

                Case Arr(i, 1) Like "M?t hàng*"
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = TenNV
                    KQ(t, 3) = Arr(i, 1)
                    TenMH = Arr(i, 1)
                    If Arr(i, 3) <> Empty And Not IsNumeric(Arr(i + 1, 1)) Then
                        KQ(t, 4) = Arr(i, 3)
                        KQ(t, 5) = Arr(i, 3)
                    End If
                    t = t + 1

                Case IsNumeric(Arr(i, 1))
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = TenNV
                    KQ(t, 3) = TenMH
                    KQ(t, 4) = Arr(i, 2) ' C?t D gi? nguyên s?
                    For j = 3 To 5
                        KQ(t, j + 2) = "'" & Arr(i, j) ' C?t E, F là d?ng Text
                    Next j
                    t = t + 1
            End Select
        End If
    Next i

    With wsKQ
        If t > 0 Then
            .Range("A2:G" & .Rows.Count).ClearContents
            .Range("A2:G" & .Rows.Count).Borders.LineStyle = xlNone
            .Range("A2").Resize(t, 7).Value = KQ
            .Range("A2").Resize(t, 7).Borders.LineStyle = 1
            .Columns(4).NumberFormat = "#,##0" ' Ð?nh d?ng c?t D là s? có d?u ph?y
            .Columns(5).NumberFormat = "@" ' Ð?nh d?ng c?t E là Text
            .Columns(6).NumberFormat = "@" ' Ð?nh d?ng c?t F là Text
        End If

        On Error Resume Next
        Set rngDel = .Range("E2:E" & t + 1).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        If Not rngDel Is Nothing Then rngDel.EntireRow.Delete Shift:=xlUp
    End With
End Sub

 

[ptm0412]

Nếu những dòng nhân viên không bắt đầu bằng "Nhân viên" mà chỉ là họ tên
Nếu những dòng cửa hàng không bắt đầu bởi "Cửa hàng" mà bắt đầu bằng "siêu thị", bằng "shop", bằng "tiệm tạp hóa", bằng số nhà
Nếu những dòng mặt hàng không bắt đầu bằng "Mặt hàng" mà bắt đầu bằng cam, quýt bưởi, bù lon, con tán
...

 

[HUONGHCKT]

ChatGPT hân hạnh tài trợ những dòng code này
(mượn code của anh HUONGHCKT ạ, nếu có gì không phải anh bỏ quá cho em nhé)

Option Explicit

Sub ABC()
    Dim i As Long, j As Long, Lr As Long, t As Long, R As Long
    Dim Arr(), KQ()
    Dim TenCH As String, TenNV As String, TenMH As String
    Dim wsGoc As Worksheet, wsKQ As Worksheet
    Dim rngDel As Range

    Set wsGoc = Sheets("Goc")
    Set wsKQ = Sheets("KetQua")

    Lr = wsGoc.Cells(wsGoc.Rows.Count, 1).End(xlUp).Row
    If Lr < 2 Then Exit Sub

    Arr = wsGoc.Range("A2:E" & Lr).Value
    R = UBound(Arr)
    ReDim KQ(1 To R, 1 To 7)

    For i = 1 To R
        If Not IsEmpty(Arr(i, 1)) Then
            Select Case True
                Case Arr(i, 1) Like "C?a hàng*"
                    t = t + 1
                    KQ(t, 1) = Arr(i, 1)
                    TenCH = Arr(i, 1)

                Case Trim(Arr(i, 1)) Like "Nhân viên*"
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = Trim(Arr(i, 1))
                    TenNV = Trim(Arr(i, 1))
                    t = t + 1

                Case Arr(i, 1) Like "M?t hàng*"
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = TenNV
                    KQ(t, 3) = Arr(i, 1)
                    TenMH = Arr(i, 1)
                    If Arr(i, 3) <> Empty And Not IsNumeric(Arr(i + 1, 1)) Then
                        KQ(t, 4) = Arr(i, 3)
                        KQ(t, 5) = Arr(i, 3)
                    End If
                    t = t + 1

                Case IsNumeric(Arr(i, 1))
                    KQ(t, 1) = TenCH
                    KQ(t, 2) = TenNV
                    KQ(t, 3) = TenMH
                    KQ(t, 4) = Arr(i, 2) ' C?t D gi? nguyên s?
                    For j = 3 To 5
                        KQ(t, j + 2) = "'" & Arr(i, j) ' C?t E, F là d?ng Text
                    Next j
                    t = t + 1
            End Select
        End If
    Next i

    With wsKQ
        If t > 0 Then
            .Range("A2:G" & .Rows.Count).ClearContents
            .Range("A2:G" & .Rows.Count).Borders.LineStyle = xlNone
            .Range("A2").Resize(t, 7).Value = KQ
            .Range("A2").Resize(t, 7).Borders.LineStyle = 1
            .Columns(4).NumberFormat = "#,##0" ' Ð?nh d?ng c?t D là s? có d?u ph?y
            .Columns(5).NumberFormat = "@" ' Ð?nh d?ng c?t E là Text
            .Columns(6).NumberFormat = "@" ' Ð?nh d?ng c?t F là Text
        End If

        On Error Resume Next
        Set rngDel = .Range("E2:E" & t + 1).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        If Not rngDel Is Nothing Then rngDel.EntireRow.Delete Shift:=xlUp
    End With
End Sub

Cảm ơn anh @hoangtuaotrang_hp_vn đã khai sáng.
Đoạn này thực sự là tôi không nghĩ đến

On Error Resume Next
        Set rngDel = .Range("E2:E" & t + 1).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If Not rngDel Is Nothing Then rngDel.EntireRow.Delete Shift:=xlUp

Bài đã được tự động gộp: 14/2/25

Sao thấy nó chạy chậm thế nhỉ

Code của tôi thuộc dạng rau má Tàu (dài, loằng ngoằng, khó tiêu,...) mà.
Trên máy tôi chạy cũng không chậm lắm.
Có lẽ do đoạn định dạng và xóa dòng trống.
Bạn sửa giúp cho tôi với nhé.

 

[DeTong]

Đây là kết quả sau khi clean bằng Query.

 

[minhminh27]

Đây là kết quả sau khi clean bằng Query.

Anh có cách clean/ làm sạch dữ liệu hay quá.
Em cũng đang tìm hiểu query, Anh có thể chia sẻ thêm để có thể làm như hình anh gửi được không ạ.
Cho em xin cả chỗ/ tài liệu có thể học về query này với

 

[DeTong]

chia sẻ thêm để có thể làm

Trong file attach.
Đứng vào vùng xanh lá, menu Query, Edit xem từng step ...

 

[minhminh27]

Trong file attach.
Đứng vào vùng xanh lá, menu Query, Edit xem từng step ...

cảm ơn Anh đã chia sẻ.
Em làm theo thì còn bước này em đang băn khoăn bước tiếp theo filter đang lọc theo tiêu chí gì
Vì em thấy kết quả mất dòng 22.

 

[DeTong]

Dữ liệu thô không đồng nhất,
Thêm sheet Goc, cell B23= 500.000;
Qua sheet Ketqua click vùng xanh lá, refresh...

Chọn các cột [Custom.2] và cột [Goods] khác trống (có dữ liệu).

 

[minhminh27]

Dữ liệu thô không đồng nhất,
Thêm sheet Goc, cell B23= 500.000;
Qua sheet Ketqua click vùng xanh lá, refresh...

Chọn các cột [Custom.2] và cột [Goods] khác trống (có dữ liệu).

Em cảm ơn,
Em mới tìm hiểu nên e loay hoay mãi mới thấy chỗ view công thức như hình ảnh Anh gửi

 

[ptm0412]

Em cảm ơn

Nhắc bạn nội dung bài 6:
Nếu những dòng nhân viên không bắt đầu bằng "Nhân viên" mà chỉ là họ tên
Nếu những dòng cửa hàng không bắt đầu bởi "Cửa hàng" mà bắt đầu bằng "siêu thị", bằng "shop", bằng "tiệm tạp hóa", bằng số nhà
Nếu những dòng mặt hàng không bắt đầu bằng "Mặt hàng" mà bắt đầu bằng cam, quýt bưởi, bù lon, con tán

Bạn đã áp VBA, Power query ở trên vào dữ liệu thật của bạn chưa?

Bạn thử file sau đây với tên mặt hàng, tên nhân viên, tên cửa hàng bất kỳ.

 

[minhminh27]

Nhắc bạn nội dung bài 6:
Nếu những dòng nhân viên không bắt đầu bằng "Nhân viên" mà chỉ là họ tên
Nếu những dòng cửa hàng không bắt đầu bởi "Cửa hàng" mà bắt đầu bằng "siêu thị", bằng "shop", bằng "tiệm tạp hóa", bằng số nhà
Nếu những dòng mặt hàng không bắt đầu bằng "Mặt hàng" mà bắt đầu bằng cam, quýt bưởi, bù lon, con tán

Bạn đã áp VBA, Power query ở trên vào dữ liệu thật của bạn chưa?

Bạn thử file sau đây với tên mặt hàng, tên nhân viên, tên cửa hàng bất kỳ.

View attachment 307087

Cảm ơn Anh đã hướng dẫn thêm về Power query ạ.
1. VBA
em đang vướng phần phân biệt như Anh nêu trên, nếu dữ liệu như hình Anh gửi thì em chưa phân biệt được.
Ý tưởng của em là sẽ áp dụng code của 2 anh ở trên và cần thêm bảng chứa tên của hàng, chứa tên nhân viên để phân biệt.

2. Power Query
Do mới tìm hiểu công cụ này, có thêm bài ví dụ của Anh thật sự đã giúp em hiểu nhiều hơn về phần xử lý dữ liệu để áp dụng cho bản thân.

 

[ptm0412]

1. VBA
Ý tưởng của em là sẽ áp dụng code của 2 anh ở trên và cần thêm bảng chứa tên của hàng, chứa tên nhân viên để phân biệt.

2. Power Query
Do mới tìm hiểu công cụ này, có thêm bài ví dụ của Anh thật sự đã giúp em hiểu nhiều hơn về phần xử lý dữ liệu để áp dụng cho bản thân.

Theo nội dung bài 1 thì cần 1 bảng với cấu trúc chuẩn để import vào Access, lấy từ bảng ban đầu.
1. Bảng ban đầu ẹ quá.
- Dư 1 số dòng, nhìn thì giống dòng tổng nhưng tiêu đề dòng không phải tổng.
- Tên cột là Goods (mặt hàng) mà lại chứa giá trị số
- Tên nhân viên thì dư 1 đống khoảng trắng. PQ tôi viết dựa vào khoảng trắng đó để phân biệt cửa hàng và nhân viên, nhưng đó là chữa cháy, không dùng làm quy tắc được.
- Cột from serial được hiểu là số serie từ - đến, nhưng dòng có tên mặt hàng lại chứa số (có thể là số lượng)
-Dòng chứa con số 1650 000 lại chẳng có chi tiết từ serie mấy đến serie mấy, dòng chứa 500,000 cũng vậy. Hai con số này có thể chẳng phải là số lượng như những dòng khác.

2. Bảng kết quả mong muốn cũng không chuẩn. Nếu để import thì phải loại trừ các dòng 1650 000 và 500,000 ra. Dữ liệu Access không chấp nhận thông tin này. Cố gắng đưa vào thì 2 con số này cũng không tính toán được, và khi tạo báo cáo Access lại không có chi tiết serie(s). Các dòng có vẻ như dòng tổng cũng loại bỏ.

Tôi làm PQ theo mẫu bảng kết quả, nhưng chỉ để xem chơi chứ để import thì sai cấu trúc.

Nói về VBA:
Chắc chắn cấu trúc Access sẽ đòi hỏi 1 bảng mã nhân viên (kèm bảng mã cửa hàng, bảng mã mặt hàng). Nhưng trong Excel thì thêm bảng cũng vô ích vì cùng 1 cột chứa 4 loại thông tin như phân tích ở mục 1. Chẳng có dấu hiệu gì để phân biệt và phải dùng mẹo:
- Dùng thông tin có 1 đống khoảng trắng để biết là Tên nhân viên
- Căn cứ vào số lượng = 0 và không có khoảng trắng đầu để xác định tên cửa hàng
- Căn cứ vào số lượng > 0 để coi là thông tin tên mặt hàng. Muốn vậy phải tạo cột số lượng trước
- Căn cứ vào độ dài của thông tin From serial để biết rằng đó là số lượng.

Cả 4 căn cứ đó chỉ là chữa cháy cho trường hợp rất cụ thể là bảng "Goc" này, dữ liệu khác đi 1 chút xíu xiu là sai ngay lập tức.

 

[ptm0412]

Bảng chuẩn để import chỉ như thế này, và làm sao cho ra được nó lại là chuyện khác.

 

[minhminh27]

Theo nội dung bài 1 thì cần 1 bảng với cấu trúc chuẩn để import vào Access, lấy từ bảng ban đầu.
1. Bảng ban đầu ẹ quá.
- Dư 1 số dòng, nhìn thì giống dòng tổng nhưng tiêu đề dòng không phải tổng.
- Tên cột là Goods (mặt hàng) mà lại chứa giá trị số
- Tên nhân viên thì dư 1 đống khoảng trắng. PQ tôi viết dựa vào khoảng trắng đó để phân biệt cửa hàng và nhân viên, nhưng đó là chữa cháy, không dùng làm quy tắc được.
- Cột from serial được hiểu là số serie từ - đến, nhưng dòng có tên mặt hàng lại chứa số (có thể là số lượng)
-Dòng chứa con số 1650 000 lại chẳng có chi tiết từ serie mấy đến serie mấy, dòng chứa 500,000 cũng vậy. Hai con số này có thể chẳng phải là số lượng như những dòng khác.

2. Bảng kết quả mong muốn cũng không chuẩn. Nếu để import thì phải loại trừ các dòng 1650 000 và 500,000 ra. Dữ liệu Access không chấp nhận thông tin này. Cố gắng đưa vào thì 2 con số này cũng không tính toán được, và khi tạo báo cáo Access lại không có chi tiết serie(s). Các dòng có vẻ như dòng tổng cũng loại bỏ.

Tôi làm PQ theo mẫu bảng kết quả, nhưng chỉ để xem chơi chứ để import thì sai cấu trúc.

Nói về VBA:
Chắc chắn cấu trúc Access sẽ đòi hỏi 1 bảng mã nhân viên (kèm bảng mã cửa hàng, bảng mã mặt hàng). Nhưng trong Excel thì thêm bảng cũng vô ích vì cùng 1 cột chứa 4 loại thông tin như phân tích ở mục 1. Chẳng có dấu hiệu gì để phân biệt và phải dùng mẹo:
- Dùng thông tin có 1 đống khoảng trắng để biết là Tên nhân viên
- Căn cứ vào số lượng = 0 và không có khoảng trắng đầu để xác định tên cửa hàng
- Căn cứ vào số lượng > 0 để coi là thông tin tên mặt hàng. Muốn vậy phải tạo cột số lượng trước
- Căn cứ vào độ dài của thông tin From serial để biết rằng đó là số lượng.

Cả 4 căn cứ đó chỉ là chữa cháy cho trường hợp rất cụ thể là bảng "Goc" này, dữ liệu khác đi 1 chút xíu xiu là sai ngay lập tức.

Cảm ơn Anh đã nhìn ra vấn đề của file ạ.
Nhìn file của chủ thớt, e nhớ đến 1 báo cáo của 1 đơn vị em từng làm, nên chắc em có thể hiểu được ý nghĩa của nó.
E giải thích thêm thôi ạ.
1. Tên cột là Goods (mặt hàng) mà lại chứa giá trị số
=> cột này cột cột số lượng hàng theo serial. Khả năng báo cáo hiện thị không như mong muốn.

2. Tên nhân viên thì dư 1 đống khoảng trắng.
=> kiểu thụt dòng trong báo cáo.

3. Cột from serial được hiểu là số serie từ - đến, nhưng dòng có tên mặt hàng lại chứa số
=> cái này là do mặt hàng này không có serail nên không có thêm dòng chi tiết serial.
Quy chuẩn là sẽ có case thư mục báo cáo như sau
- 1 dòng cửa hàng,
- tiếp theo là dòng nhân viên,
- tiếp theo là dòng mặt hàng chứa tên mặt hàng và tổng số lượng của mặt hàng này,
- tiếp theo là dòng chi tiết serial với số lượng tương ứng, chất lượng là hàng New hay hỏng, đổi trả. (không có serial, thì sẽ không có dòng này)

 

[ptm0412]

=> cột này cột cột số lượng hàng theo serial. Khả năng báo cáo hiện thị không như mong muốn.
=> kiểu thụt dòng trong báo cáo.

Cái này thì tôi nhìn và biết chứ. Thụt đầu dòng thì sử dụng indent hoặc tách cột chứ không ai làm như vậy.

3. => cái này là do mặt hàng này không có serail nên không có thêm dòng chi tiết serial.

Phải có cột số lượng riêng. Không có serial thì 2 cột serie phải bỏ trống.
Dòng tổng phải ghi tiêu đề là tổng. Tổng mặt hàng, tổng nhân viên, hay tổng cửa hàng phải ghi rõ.

Tôi là người thiết kế report cho phần mềm nên tôi biết phải làm thế nào để bất kỳ người nào đọc báo cáo cũng hiểu.