Chuyển dữ liệu đang hiện theo dòng sang hiện theo cột (5 người xem)

MinhKhai · 7/5/19

Kính chào các anh chị

Em có người bạn nhờ làm giúp, mới đầu tưởng dễ mà hóa ra quá sức của em. Em xin nhờ các anh chị em tiếp tục hỗ trợ

Em có file dữ liệu về nhật ký chạy xe được cập nhật hàng ngày, mỗi dòng là 1 lượt xe chạy. Một ngày có xe có thể chạy nhiều chuyến và có xe không chạy.
Khi dữ liệu được nhập vào nhiều, việc nhìn tổng thể các chuyến của xe khá khó khăn, vì thế cần bố trí dữ liệu sang dạng cột như sheet Monitor bên cạnh

Rất mong các anh chị em xây dựng Hàm hay Code để tự động chuyển đổi việc bố trí dữ liệu như nó trên (Vui lòng xem file đính kèm để hiểu rõ hơn)

Xin cảm ơn

be_09 · 7/5/19

MinhKhai đã viết:
Kính chào các anh chị

Em có người bạn nhờ làm giúp, mới đầu tưởng dễ mà hóa ra quá sức của em. Em xin nhờ các anh chị em tiếp tục hỗ trợ

Em có file dữ liệu về nhật ký chạy xe được cập nhật hàng ngày, mỗi dòng là 1 lượt xe chạy. Một ngày có xe có thể chạy nhiều chuyến và có xe không chạy.
Khi dữ liệu được nhập vào nhiều, việc nhìn tổng thể các chuyến của xe khá khó khăn, vì thế cần bố trí dữ liệu sang dạng cột như sheet Monitor bên cạnh

Rất mong các anh chị em xây dựng Hàm hay Code để tự động chuyển đổi việc bố trí dữ liệu như nó trên (Vui lòng xem file đính kèm để hiểu rõ hơn)

Xin cảm ơn

Anh đang đi Nha Trang nên không có máy để xem file, nhưng anh nghĩ phải có 1 sheet danh mục xe để tra cứu và nhập liệu nhanh theo chiều dọc sau đó sử dụng PivotTable để tổng hợp

quanluu · 7/5/19

MinhKhai đã viết:
Kính chào các anh chị

Em có người bạn nhờ làm giúp, mới đầu tưởng dễ mà hóa ra quá sức của em. Em xin nhờ các anh chị em tiếp tục hỗ trợ

Em có file dữ liệu về nhật ký chạy xe được cập nhật hàng ngày, mỗi dòng là 1 lượt xe chạy. Một ngày có xe có thể chạy nhiều chuyến và có xe không chạy.
Khi dữ liệu được nhập vào nhiều, việc nhìn tổng thể các chuyến của xe khá khó khăn, vì thế cần bố trí dữ liệu sang dạng cột như sheet Monitor bên cạnh

Rất mong các anh chị em xây dựng Hàm hay Code để tự động chuyển đổi việc bố trí dữ liệu như nó trên (Vui lòng xem file đính kèm để hiểu rõ hơn)

Xin cảm ơn

Bạn chạy code này, code này code cho tối đa 5 chuyến, nếu nhiều hơn thì bạn tự chỉnh

Mã:

Sub tonghop()
    Dim ngayth, i, k, ar, dic, chuyenso, kq
    With Sheet6
        .Range("A3:K" & .Range("A" & Rows.Count).End(3).Row + 1).ClearContents
        ngayth = .Range("N1")
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("B3:K" & Sheet1.Range("B" & Rows.Count).End(3).Row)
    ReDim kq(1 To UBound(ar), 1 To 11)
    For i = 1 To UBound(ar)
        If ar(i, 1) = ngayth Then
            chuyenso = ar(i, 7)
            If Not dic.exists(ar(i, 3)) Then
                k = k + 1
                dic.Add ar(i, 3), k
                kq(k, 1) = ar(i, 3)
                kq(k, chuyenso * 2) = ar(i, 9)
                kq(k, chuyenso * 2 + 1) = ar(i, 10)
            Else
                kq(dic.Item(ar(i, 3)), 1) = ar(i, 3)
                kq(dic.Item(ar(i, 3)), chuyenso * 2) = ar(i, 9)
                kq(dic.Item(ar(i, 3)), chuyenso * 2 + 1) = ar(i, 10)
            End If
        End If
    Next
    If k Then
        Sheet6.Range("A3").Resize(k, 11) = kq
    End If
End Sub

giaiphap · 7/5/19

MinhKhai đã viết:
Kính chào các anh chị

Em có người bạn nhờ làm giúp, mới đầu tưởng dễ mà hóa ra quá sức của em. Em xin nhờ các anh chị em tiếp tục hỗ trợ

Em có file dữ liệu về nhật ký chạy xe được cập nhật hàng ngày, mỗi dòng là 1 lượt xe chạy. Một ngày có xe có thể chạy nhiều chuyến và có xe không chạy.
Khi dữ liệu được nhập vào nhiều, việc nhìn tổng thể các chuyến của xe khá khó khăn, vì thế cần bố trí dữ liệu sang dạng cột như sheet Monitor bên cạnh

Rất mong các anh chị em xây dựng Hàm hay Code để tự động chuyển đổi việc bố trí dữ liệu như nó trên (Vui lòng xem file đính kèm để hiểu rõ hơn)

Xin cảm ơn

Bạn xem thử file. (Lại chậm hơn @quanluu1989 )

Ba Tê · 8/5/19

MinhKhai đã viết:
Kính chào các anh chị

Em có người bạn nhờ làm giúp, mới đầu tưởng dễ mà hóa ra quá sức của em. Em xin nhờ các anh chị em tiếp tục hỗ trợ

Em có file dữ liệu về nhật ký chạy xe được cập nhật hàng ngày, mỗi dòng là 1 lượt xe chạy. Một ngày có xe có thể chạy nhiều chuyến và có xe không chạy.
Khi dữ liệu được nhập vào nhiều, việc nhìn tổng thể các chuyến của xe khá khó khăn, vì thế cần bố trí dữ liệu sang dạng cột như sheet Monitor bên cạnh

Rất mong các anh chị em xây dựng Hàm hay Code để tự động chuyển đổi việc bố trí dữ liệu như nó trên (Vui lòng xem file đính kèm để hiểu rõ hơn)

Xin cảm ơn

Thêm một chút "mau me".

MinhKhai · 8/5/19

quanluu1989 đã viết:

Bạn chạy code này, code này code cho tối đa 5 chuyến, nếu nhiều hơn thì bạn tự chỉnh

Mã:

Sub tonghop()
    Dim ngayth, i, k, ar, dic, chuyenso, kq
    With Sheet6
        .Range("A3:K" & .Range("A" & Rows.Count).End(3).Row + 1).ClearContents
        ngayth = .Range("N1")
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("B3:K" & Sheet1.Range("B" & Rows.Count).End(3).Row)
    ReDim kq(1 To UBound(ar), 1 To 11)
    For i = 1 To UBound(ar)
        If ar(i, 1) = ngayth Then
            chuyenso = ar(i, 7)
            If Not dic.exists(ar(i, 3)) Then
                k = k + 1
                dic.Add ar(i, 3), k
                kq(k, 1) = ar(i, 3)
                kq(k, chuyenso * 2) = ar(i, 9)
                kq(k, chuyenso * 2 + 1) = ar(i, 10)
            Else
                kq(dic.Item(ar(i, 3)), 1) = ar(i, 3)
                kq(dic.Item(ar(i, 3)), chuyenso * 2) = ar(i, 9)
                kq(dic.Item(ar(i, 3)), chuyenso * 2 + 1) = ar(i, 10)
            End If
        End If
    Next
    If k Then
        Sheet6.Range("A3").Resize(k, 11) = kq
    End If
End Sub

Cảm ơn bạn @quanluu1989. Code của bạn đã chạy đúng ý mình, mình chưa test kỹ được và cũng chưa hiểu code để sửa nếu cần >5 chuyến. Mình sẽ hỏi thêm bạn sau nhé.

giaiphap đã viết:
Bạn xem thử file. (Lại chậm hơn @quanluu1989 )

Cảm ơn @giaiphap. Code của bạn chạy rất tốt, đã đúng yêu cầu của mình. Bạn đã chu đáo khi bổ sung thêm sự kiện Worksheet_Change.
Tuy nhiên mình đã test nhanh và thấy xảy ra vấn đề nhỏ như sau:
Nếu ô N1 vẫn có dữ liệu mà user thao tác gì ở vùng dữ liệu được hiển thị thì sẽ báo lỗi.

Lỗi tại đây

Mình đang chưa hiểu sao Target.Address đang <>N1 mà sự kiện vẫn bị kích hoạt ?

Ba Tê đã viết:
Thêm một chút "mau me".

Cảm ơn bác 3T. Các cụ nói "Gừng càng già càng cay". Code của bác cũng chu đáo ở chỗ không chỉ ẩn các cột dư thừa mà còn bắt lỗi nhập sai ngày. Cảm ơn bác nhiều

Các anh @quanluu1989, @giaiphap và @Ba Tê cho em hỏi thêm về 1 tình huống khác: Nếu các mã xe tại cột A của sheet Monitor giữ nguyên, dữ liệu được đổ vào các cột bên phải (mã xe nào không chạy thì bỏ trống) thay vì chỉ hiện các xe có trong sheet NhatTrinh như giải pháp các anh đã đưa ra thì làm như thế nào ?
Xin cảm ơn tất cả

giaiphap · 8/5/19

MinhKhai đã viết:
Cảm ơn bạn @quanluu1989. Code của bạn đã chạy đúng ý mình, mình chưa test kỹ được và cũng chưa hiểu code để sửa nếu cần >5 chuyến. Mình sẽ hỏi thêm bạn sau nhé.

Cảm ơn @giaiphap. Code của bạn chạy rất tốt, đã đúng yêu cầu của mình. Bạn đã chu đáo khi bổ sung thêm sự kiện Worksheet_Change.
Tuy nhiên mình đã test nhanh và thấy xảy ra vấn đề nhỏ như sau:
Nếu ô N1 vẫn có dữ liệu mà user thao tác gì ở vùng dữ liệu được hiển thị thì sẽ báo lỗi.
View attachment 216719

Lỗi tại đây
View attachment 216720
Mình đang chưa hiểu sao Target.Address đang <>N1 mà sự kiện vẫn bị kích hoạt ?

Cảm ơn bác 3T. Các cụ nói "Gừng càng già càng cay". Code của bác cũng chu đáo ở chỗ không chỉ ẩn các cột dư thừa mà còn bắt lỗi nhập sai ngày. Cảm ơn bác nhiều

Các anh @quanluu1989, @giaiphap và @Ba Tê cho em hỏi thêm về 1 tình huống khác: Nếu các mã xe tại cột A của sheet Monitor giữ nguyên, dữ liệu được đổ vào các cột bên phải (mã xe nào không chạy thì bỏ trống) thay vì chỉ hiện các xe có trong sheet NhatTrinh như giải pháp các anh đã đưa ra thì làm như thế nào ?
Xin cảm ơn tất cả

Bạn xem lại file

MinhKhai · 8/5/19

giaiphap đã viết:
Bạn xem lại file

Cảm ơn sự giúp đỡ rất nhanh chóng. Code đã chạy đúng ý kiến mới của em.
Em đã test nhanh và thấy: Nếu vô tình xóa bớt 1 hoặc nhiều mã xe thì VBA báo lỗi

Anh có thể sửa code sao cho có thể Thêm hoặc Bớt mã xe mà code vẫn chạy tốt được không? hoặc ít nhất có 1 Msgbox để User biết đang bị lỗi tại đâu.
Ngoài ra nếu không phiền anh cho ghi chú vào code để em học hỏi.
Xin cảm ơn

giaiphap · 8/5/19

MinhKhai đã viết:
Cảm ơn sự giúp đỡ rất nhanh chóng. Code đã chạy đúng ý kiến mới của em.
Em đã test nhanh và thấy: Nếu vô tình xóa bớt 1 hoặc nhiều mã xe thì VBA báo lỗi
View attachment 216723

Anh có thể sửa code sao cho có thể Thêm hoặc Bớt mã xe mà code vẫn chạy tốt được không? hoặc ít nhất có 1 Msgbox để User biết đang bị lỗi tại đâu.
Ngoài ra nếu không phiền anh cho ghi chú vào code để em học hỏi.
Xin cảm ơn

Thử lại thế này xem sao.

Mã:

Public Sub GPE_Filter(aDate)
Dim Dic As Object, Tmp
Dim i As Long, k As Long
Dim Arr, dArr, sArr
Arr = Sheet1.Range(Sheet1.[B3], Sheet1.[K3].End(xlDown)).Value

With Sheet6
    .Range("B3:K" & (.Range("A1000000").End(xlUp).Row + 2)).ClearContents
    dArr = .Range("A3:K" & .[A3].End(xlDown).Row).Value
    ReDim sArr(1 To (UBound(dArr, 1) + UBound(Arr, 1)), 1 To 11)
    Set Dic = CreateObject("Scripting.Dictionary")
    k = 0
        With Dic
            For i = 1 To UBound(dArr, 1)
                Tmp = dArr(i, 1)
              If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                sArr(k, 1) = Tmp
              End If
            Next i
            For i = 1 To UBound(Arr, 1)
                Tmp = Arr(i, 3)
                If Arr(i, 1) = aDate Then
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        sArr(k, 1) = Arr(i, 3)
                        sArr(k, Arr(i, 7) * 2) = Arr(i, 9)
                        sArr(k, Arr(i, 7) * 2 + 1) = Arr(i, 10)
                    Else
                        sArr(.Item(Tmp), Arr(i, 7) * 2) = Arr(i, 9)
                        sArr(.Item(Tmp), Arr(i, 7) * 2 + 1) = Arr(i, 10)
                    End If
                End If
            Next i
            Set Dic = Nothing
        End With
        If k Then .Range("A3").Resize(k, 11) = sArr
    End With
End Sub

MinhKhai · 8/5/19

giaiphap đã viết:

Thử lại thế này xem sao.

Mã:

Public Sub GPE_Filter(aDate)
Dim Dic As Object, Tmp
Dim i As Long, k As Long
Dim Arr, dArr, sArr
Arr = Sheet1.Range(Sheet1.[B3], Sheet1.[K3].End(xlDown)).Value

With Sheet6
    .Range("B3:K" & (.Range("A1000000").End(xlUp).Row + 2)).ClearContents
    dArr = .Range("A3:K" & .[A3].End(xlDown).Row).Value
    ReDim sArr(1 To (UBound(dArr, 1) + UBound(Arr, 1)), 1 To 11)
    Set Dic = CreateObject("Scripting.Dictionary")
    k = 0
        With Dic
            For i = 1 To UBound(dArr, 1)
                Tmp = dArr(i, 1)
              If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                sArr(k, 1) = Tmp
              End If
            Next i
            For i = 1 To UBound(Arr, 1)
                Tmp = Arr(i, 3)
                If Arr(i, 1) = aDate Then
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        sArr(k, 1) = Arr(i, 3)
                        sArr(k, Arr(i, 7) * 2) = Arr(i, 9)
                        sArr(k, Arr(i, 7) * 2 + 1) = Arr(i, 10)
                    Else
                        sArr(.Item(Tmp), Arr(i, 7) * 2) = Arr(i, 9)
                        sArr(.Item(Tmp), Arr(i, 7) * 2 + 1) = Arr(i, 10)
                    End If
                End If
            Next i
            Set Dic = Nothing
        End With
        If k Then .Range("A3").Resize(k, 11) = sArr
    End With
End Sub

Em test thử tình huống như sau mà chưa rõ quy luật:
- Đầu tiên em dùng Conditional Formatting để highlight nhưng ô bị đúp (duplicate) về mặt giá trị
- Tiếp theo em cố tình xóa 1 ô nào đó ở cột A, rồi tạo 1 ô bị đúp giá trị
- Chạy code: bằng cách tạo Worksheet_Change tại ô N1: Lúc thì code khôi phục ô bị xóa, lúc thì lại không ? ---> Chưa rõ cùng 1 cách chạy mà ra kết quả khác nhau??

Ngoài ra, em thử với sự kiện Worksheet_Activate thì báo lỗi. Không rõ nguyên nhân gì vậy ?

Ba Tê · 8/5/19

MinhKhai đã viết:
Cảm ơn bác 3T. Các cụ nói "Gừng càng già càng cay". Code của bác cũng chu đáo ở chỗ không chỉ ẩn các cột dư thừa mà còn bắt lỗi nhập sai ngày. Cảm ơn bác nhiều

Các anh @quanluu1989, @giaiphap và @Ba Tê cho em hỏi thêm về 1 tình huống khác: Nếu các mã xe tại cột A của sheet Monitor giữ nguyên, dữ liệu được đổ vào các cột bên phải (mã xe nào không chạy thì bỏ trống) thay vì chỉ hiện các xe có trong sheet NhatTrinh như giải pháp các anh đã đưa ra thì làm như thế nào ?
Xin cảm ơn tất cả

Nếu vậy thì càng nhẹ nhàng hơn.

huuthang_bd · 9/5/19

Góp vui (công thức mảng)

Mã:

=IFERROR(VLOOKUP($C$2&"_"&$A5&"_"&ROUND(COLUMN(A1)/2,0),CHOOSE(COLUMN($A$1:$B$1),NhatTrinh!$B$3:$B$86&"_"&NhatTrinh!$D$3:$D$86&"_"&NhatTrinh!$H$3:$H$86,IF(Monitor!B$4="Điểm đi",NhatTrinh!$J$3:$J$86,NhatTrinh!$K$3:$K$86)),2,0),"")

MinhKhai · 10/5/19

huuthang_bd đã viết:
Góp vui (công thức mảng)

Mã:

=IFERROR(VLOOKUP($C$2&"_"&$A5&"_"&ROUND(COLUMN(A1)/2,0),CHOOSE(COLUMN($A$1:$B$1),NhatTrinh!$B$3:$B$86&"_"&NhatTrinh!$D$3:$D$86&"_"&NhatTrinh!$H$3:$H$86,IF(Monitor!B$4="Điểm đi",NhatTrinh!$J$3:$J$86,NhatTrinh!$K$3:$K$86)),2,0),"")

Không rõ dán vào ô nào mà em không thấy kết quả của hàm
Anh giải thích thêm giúp với nhé

huuthang_bd · 10/5/19

C

MinhKhai đã viết:
Không rõ dán vào ô nào mà em không thấy kết quả của hàm
Anh giải thích thêm giúp với nhé

Bạn có dùng dạng công thức mảng không? Lúc lập công thức tôi dùng file của anh Ba Tê ở bài 11.

SA_DQ · 10/5/19

File này dành cho những người chưa có kiến thức về Dictionary & chỉ liệt kê những xe có xuất bến trong ngày thôi

Chuyển dữ liệu đang hiện theo dòng sang hiện theo cột (5 người xem)

Người dùng đang xem chủ đề này

Giải pháp Ếc-xào

File đính kèm

Biên Hòa, Đồng Nai

Thành viên gắn bó

==(^o^)==

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Giải pháp Ếc-xào

==(^o^)==

File đính kèm

Giải pháp Ếc-xào

==(^o^)==

Giải pháp Ếc-xào

Cạo Rồi Khỏi Gội

File đính kèm

Chuyên gia GPE

Giải pháp Ếc-xào

Chuyên gia GPE

/(hông là gì!

File đính kèm

Đếm ngược thời gian