Giúp đỡ sắp xếp lại dữ liệu theo cột ngày tháng năm bằng vba (2 người xem)

chidung2009 · 1/2/23

Xin chào toàn thể ac trong Diễn đàn GPE
Mình có bảng dữ liệu như như sau:
Cột A5 là thứ tự, B5 là cột ngày tháng năm, C5 là tên nv, D5 Ghi chú ( tiêu đề nhãn, dữ liệu bắt đầu hàng thứ 6 trở đi);
Riêng cột B có dữ liệu ngày tháng năm bị xếp theo lộn xộn. Giờ mình muốn sắp xếp lại dữ liệu theo thứ tự ngày tháng tăng dần sang cột H trở đi (cùng sheet). Tức là bảng dữ liệu A5 -> D5 vẫn giữ nguyên. Bảng dữ liệu từ cột H trở đi thì được sắp xếp lại.
Mình rất mong được các anh chị giúp đỡ.
Mình xin trân thành cảm ơn ạ

Thóc Sama · 1/2/23

chidung2009 đã viết:
Xin chào toàn thể ac trong Diễn đàn GPE
Mình có bảng dữ liệu như như sau:
Cột A5 là thứ tự, B5 là cột ngày tháng năm, C5 là tên nv, D5 Ghi chú ( tiêu đề nhãn, dữ liệu bắt đầu hàng thứ 6 trở đi);
Riêng cột B có dữ liệu ngày tháng năm bị xếp theo lộn xộn. Giờ mình muốn sắp xếp lại dữ liệu theo thứ tự ngày tháng tăng dần sang cột H trở đi (cùng sheet). Tức là bảng dữ liệu A5 -> D5 vẫn giữ nguyên. Bảng dữ liệu từ cột H trở đi thì được sắp xếp lại.
Mình rất mong được các anh chị giúp đỡ.
Mình xin trân thành cảm ơn ạ

Tạo cột số thứ tự (STT) sau đó sort theo cột ngày, copy dữ liệu sang cột H xong rồi lại sort lại theo cột STT là xong.
Nếu dùng code thì cũng record macro như thế xem thế nào.

chidung2009 · 1/2/23

THÓC SAMA đã viết:
Tạo cột số thứ tự (STT) sau đó sort theo cột ngày, copy dữ liệu sang cột H xong rồi lại sort lại theo cột STT là xong.
Nếu dùng code thì cũng record macro như thế xem thế nào.

Do file excel của mình đã khoá Protect Sheet nên không Sort được nữa, mặt khác nếu Sort thì công thức ở sheet khác sẽ bị lỗi tham chiếu

Thóc Sama · 1/2/23

chidung2009 đã viết:
Do file excel của mình đã khoá Protect Sheet nên không Sort được nữa, mặt khác nếu Sort thì công thức ở sheet khác sẽ bị lỗi tham chiếu

Thì trước khi sort bạn Unprotect và vụ sort dữ liệu sheet khác lỗi thế nào thì phải có file (có thể là giả định) để mọi người còn giúp chứ?!

LmoovoenX · 1/2/23

chidung2009 đã viết:
Xin chào toàn thể ac trong Diễn đàn GPE
Mình có bảng dữ liệu như như sau:
Cột A5 là thứ tự, B5 là cột ngày tháng năm, C5 là tên nv, D5 Ghi chú ( tiêu đề nhãn, dữ liệu bắt đầu hàng thứ 6 trở đi);
Riêng cột B có dữ liệu ngày tháng năm bị xếp theo lộn xộn. Giờ mình muốn sắp xếp lại dữ liệu theo thứ tự ngày tháng tăng dần sang cột H trở đi (cùng sheet). Tức là bảng dữ liệu A5 -> D5 vẫn giữ nguyên. Bảng dữ liệu từ cột H trở đi thì được sắp xếp lại.
Mình rất mong được các anh chị giúp đỡ.
Mình xin trân thành cảm ơn ạ

Vậy ở cột H dùng hàm small(cột B,row(a1)) rồi kéo xuống được không bạn. Các cột còn lại dùng match với index.

chidung2009 · 1/2/23

LmoovoenX đã viết:
Vậy ở cột H dùng hàm small(cột B,row(a1)) rồi kéo xuống được không bạn. Các cột còn lại dùng match với index.

Bảng dữ liệu mình cả ngàn dòng nếu đặt công thức vậy sẽ làm file nặng và bị lag, hơn nữa bảng dữ liệu liệu gốc còn nhập hàng ngày nữa. Nếu đặt công thức sẽ rất bất tiện

HUONGHCKT · 1/2/23

chidung2009 đã viết:
Xin chào toàn thể ac trong Diễn đàn GPE
Mình có bảng dữ liệu như như sau:
Cột A5 là thứ tự, B5 là cột ngày tháng năm, C5 là tên nv, D5 Ghi chú ( tiêu đề nhãn, dữ liệu bắt đầu hàng thứ 6 trở đi);
Riêng cột B có dữ liệu ngày tháng năm bị xếp theo lộn xộn. Giờ mình muốn sắp xếp lại dữ liệu theo thứ tự ngày tháng tăng dần sang cột H trở đi (cùng sheet). Tức là bảng dữ liệu A5 -> D5 vẫn giữ nguyên. Bảng dữ liệu từ cột H trở đi thì được sắp xếp lại.
Mình rất mong được các anh chị giúp đỡ.
Mình xin trân thành cảm ơn ạ

Bạn nên có file giả định để mọi người có thể code và test thử.
Trong khi chờ các giải pháp khác và Nếu không chê thì có thể dùng tạm code sau:

Mã:

Option Explicit

Sub Xep()
Dim i&, j&, R&, Lr&, C&, d&
Dim Arr(), KQ()
Dim Rng As Range
Dim Sh As Worksheet
Set Sh = Sheet1
On Error resume next
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If Lr<=5 then exit sub
Set Rng = Sh.Range("B6:B" & Lr)
Arr = Sh.Range("A6:D" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To C)
For i = 1 To R
    For d = 1 To R
        If Arr(d, 2) = Application.Small(Rng, i) Then
            For j = 1 To C
                KQ(i, j) = Arr(d, j)
            Next j
        End If
    Next d
Next i
Sh.Range("H6").Resize(R, C).ClearContents
Sh.Range("H6").Resize(R, C) = KQ
msgbox "Done"
End Sub

Các vẫn đề về bẫy lỗi bạn tự làm.
Chúc thành công.

chidung2009 · 1/2/23

HUONGHCKT đã viết:
Bạn nên có file giả định để mọi người có thể code và test thử.
Trong khi chờ các giải pháp khác và Nếu không chê thì có thể dùng tạm code sau:

Mã:

Option Explicit Sub Xep() Dim i&, j&, R&, Lr&, C&, d& Dim Arr(), KQ() Dim Rng As Range Dim Sh As Worksheet Set Sh = Sheet1 On Error resume next Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row If Lr<=5 then exit sub Set Rng = Sh.Range("B6:B" & Lr) Arr = Sh.Range("A6:D" & Lr).Value R = UBound(Arr): C = UBound(Arr, 2) ReDim KQ(1 To R, 1 To C) For i = 1 To R For d = 1 To R If Arr(d, 2) = Application.Small(Rng, i) Then For j = 1 To C KQ(i, j) = Arr(d, j) Next j End If Next d Next i Sh.Range("H6").Resize(R, C).ClearContents Sh.Range("H6").Resize(R, C) = KQ msgbox "Done" End Sub

Các vẫn đề về bẫy lỗi bạn tự làm.
Chúc thành công.

Code VBA của bạn đã đúng với ý tưởng của mình rồi. Mình cảm ơn bạn rất nhiều...

Thóc Sama · 1/2/23

HUONGHCKT đã viết:
Bạn nên có file giả định để mọi người có thể code và test thử.
Trong khi chờ các giải pháp khác và Nếu không chê thì có thể dùng tạm code sau:

Mã:

Option Explicit Sub Xep() Dim i&, j&, R&, Lr&, C&, d& Dim Arr(), KQ() Dim Rng As Range Dim Sh As Worksheet Set Sh = Sheet1 On Error resume next Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row If Lr<=5 then exit sub Set Rng = Sh.Range("B6:B" & Lr) Arr = Sh.Range("A6:D" & Lr).Value R = UBound(Arr): C = UBound(Arr, 2) ReDim KQ(1 To R, 1 To C) For i = 1 To R For d = 1 To R If Arr(d, 2) = Application.Small(Rng, i) Then For j = 1 To C KQ(i, j) = Arr(d, j) Next j End If Next d Next i Sh.Range("H6").Resize(R, C).ClearContents Sh.Range("H6").Resize(R, C) = KQ msgbox "Done" End Sub

Các vẫn đề về bẫy lỗi bạn tự làm.
Chúc thành công.

Em chưa thử, nhưng hình như dư 1 vòng lặp i(d) bác hả?!

HUONGHCKT · 1/2/23

Cảm ơn bạn đã xem bài.
Vòng for i=1 to R là vòng để lấy giá trị cho hàm Small(Rng,i)
Vòng For d= 1 to R là vòng lặp duyệt từng dong của mảng để lấy dòng thỏa mãn Arr(d,2)=Small(Rng,i).
Thực ra tôi cũng không test kỹ, nếu thừa bạn đính chính lại hộ nhé.

Thóc Sama · 1/2/23

HUONGHCKT đã viết:
Cảm ơn bạn đã xem bài.
Vòng for i=1 to R là vòng để lấy giá trị cho hàm Small(Rng,i)
Vòng For d= 1 to R là vòng lặp duyệt từng dong của mảng để lấy dòng thỏa mãn Arr(d,2)=Small(Rng,i).
Thực ra tôi cũng không test kỹ, nếu thừa bạn đính chính lại hộ nhé.

Em thử sửa thế này, bác xem được không nhé!
@chủ thớt test với dữ liệu thật dùm nhé!

Mã:

Option Explicit

Sub Xep()
Dim i&, j&, R&, Lr&, C&, d&
Dim Arr(), KQ()
Dim Rng As Range
Dim Sh As Worksheet
Set Sh = Sheet1
On Error Resume Next
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If Lr <= 5 Then Exit Sub
Set Rng = Sh.Range("B6:B" & Lr)
Arr = Sh.Range("A6:D" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To C)
'For i = 1 To R
    For d = 1 To R
        If Arr(d, 2) = Application.Small(Rng, d) Then
            For j = 1 To C
                KQ(d, j) = Arr(d, j)
            Next j
        End If
    Next d
'Next i
Sh.Range("M6").Resize(R, C).ClearContents
Sh.Range("M6").Resize(R, C) = KQ
MsgBox "Done"
End Sub

chidung2009 · 1/2/23

HUONGHCKT đã viết:
Bạn nên có file giả định để mọi người có thể code và test thử.
Trong khi chờ các giải pháp khác và Nếu không chê thì có thể dùng tạm code sau:

Mã:

Option Explicit Sub Xep() Dim i&, j&, R&, Lr&, C&, d& Dim Arr(), KQ() Dim Rng As Range Dim Sh As Worksheet Set Sh = Sheet1 On Error resume next Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row If Lr<=5 then exit sub Set Rng = Sh.Range("B6:B" & Lr) Arr = Sh.Range("A6:D" & Lr).Value R = UBound(Arr): C = UBound(Arr, 2) ReDim KQ(1 To R, 1 To C) For i = 1 To R For d = 1 To R If Arr(d, 2) = Application.Small(Rng, i) Then For j = 1 To C KQ(i, j) = Arr(d, j) Next j End If Next d Next i Sh.Range("H6").Resize(R, C).ClearContents Sh.Range("H6").Resize(R, C) = KQ msgbox "Done" End Sub

Các vẫn đề về bẫy lỗi bạn tự làm.
Chúc thành công.

Sau khi mình kiểm tra lại thì dữ liệu chuyển sang bảng mới bị sai, nhất là khi có nhiều hàng cùng ngày thì code lấy dữ liệu bị sai

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

THÓC SAMA đã viết:

Em thử sửa thế này, bác xem được không nhé!
@chủ thớt test với dữ liệu thật dùm nhé!

Mã:

Option Explicit

Sub Xep()
Dim i&, j&, R&, Lr&, C&, d&
Dim Arr(), KQ()
Dim Rng As Range
Dim Sh As Worksheet
Set Sh = Sheet1
On Error Resume Next
Lr = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If Lr <= 5 Then Exit Sub
Set Rng = Sh.Range("B6:B" & Lr)
Arr = Sh.Range("A6:D" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R, 1 To C)
'For i = 1 To R
    For d = 1 To R
        If Arr(d, 2) = Application.Small(Rng, d) Then
            For j = 1 To C
                KQ(d, j) = Arr(d, j)
            Next j
        End If
    Next d
'Next i
Sh.Range("M6").Resize(R, C).ClearContents
Sh.Range("M6").Resize(R, C) = KQ
MsgBox "Done"
End Sub

Cảm ơn bạn, Code của bạn sửa khi lấy dữ liệu bị sai nhiều lắm

Maika8008 · 1/2/23

Tôi nghĩ để đơn giản thì dùng vba chép dữ liệu sang 1 sheet nào đó không protect để sort rồi chép lại vào cột H của sheet nguồn.

Thóc Sama · 1/2/23

Maika8008 đã viết:
Tôi nghĩ để đơn giản thì dùng vba chép dữ liệu sang 1 sheet nào đó không protect để sort rồi chép lại vào cột H của sheet nguồn.

Nó dạng thế này hả bác?!

Mã:

Option Explicit
Sub GPE()
    Dim lr&, Ws As Worksheet
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        If Ws.Name = "TEMP" Then Ws.Delete
    Next Ws
    Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TEMP"
    Sheets("HD").Range("A5").CurrentRegion.Copy _
    Sheets("TEMP").Range("A5")
    With Sheets("TEMP")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        With Range("A5:D" & lr)
            .Sort .Cells(6, 2), 1, Header:=xlGuess
            Sheets("HD").Range("H6:K" & lr).ClearContents
            Sheets("TEMP").Range("B6:D" & lr).Copy Sheets("HD").Range("I6")
        End With
        Sheets("TEMP").Delete
    End With
    With Sheets("HD")
        .Range("A6:A" & lr).Copy .Range("H6")
    End With
    MsgBox "Done"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Maika8008 · 1/2/23

THÓC SAMA đã viết:

Nó dạng thế này hả bác?!

Mã:

Option Explicit
Sub GPE()
    Dim lr&, Ws As Worksheet
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        If Ws.Name = "TEMP" Then Ws.Delete
    Next Ws
    Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TEMP"
    Sheets("HD").Range("A5").CurrentRegion.Copy _
    Sheets("TEMP").Range("A5")
    With Sheets("TEMP")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        With Range("A5:D" & lr)
            .Sort .Cells(6, 2), 1, Header:=xlGuess
            Sheets("HD").Range("H6:K" & lr).ClearContents
            Sheets("TEMP").Range("B6:D" & lr).Copy Sheets("HD").Range("I6")
        End With
        Sheets("TEMP").Delete
    End With
    With Sheets("HD")
        .Range("A6:A" & lr).Copy .Range("H6")
    End With
    MsgBox "Done"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Chắc là như vậy đó. Test vài dòng chạy ổn là tốt rồi. Dùng sort của Excel cho đỡ viết code sort lằng nhằng mà chưa chắc đã ổn.

chidung2009 · 2/2/23

Maika8008 đã viết:
Chắc là như vậy đó. Test vài dòng chạy ổn là tốt rồi. Dùng sort của Excel cho đỡ viết code sort lằng nhằng mà chưa chắc đã ổn

Ý tưởng của bạn rất hay. Mình cảm ơn rất nhiều

HUONGHCKT · 2/2/23

File giả định tôi tự lập trên máy tôi chạy tốt mà.
Có mỗi yêu cầu gửi file giả định lên mà cũng không đáp ứng được, thử hỏi bạn chủ thớt muốn được ăn sẵn mà không cần nhọc công sao? Tôi cũng không hiểu sao các thành viên khác cứ phải tốn thời gian và công sức nhỉ?

Maika8008 · 2/2/23

HUONGHCKT đã viết:
Có mỗi yêu cầu gửi file giả định lên mà cũng không đáp ứng được, thử hỏi bạn chủ thớt muốn được ăn sẵn mà không cần nhọc công sao? Tôi cũng không hiểu sao các thành viên khác cứ phải tốn thời gian và công sức nhỉ?

Đầu năm nên mọi người còn vui vẻ dễ tính đấy thôi. Vài hôm nữa là đâu lại vào đấy à. --=0

Thóc Sama · 2/2/23

HUONGHCKT đã viết:
File giả định tôi tự lập trên máy tôi chạy tốt mà.
Có mỗi yêu cầu gửi file giả định lên mà cũng không đáp ứng được, thử hỏi bạn chủ thớt muốn được ăn sẵn mà không cần nhọc công sao? Tôi cũng không hiểu sao các thành viên khác cứ phải tốn thời gian và công sức nhỉ?

Đầu năm nên xuề xoà tí cho vui bác!

chidung2009 · 2/2/23

HUONGHCKT đã viết:
File giả định tôi tự lập trên máy tôi chạy tốt mà.
Có mỗi yêu cầu gửi file giả định lên mà cũng không đáp ứng được, thử hỏi bạn chủ thớt muốn được ăn sẵn mà không cần nhọc công sao? Tôi cũng không hiểu sao các thành viên khác cứ phải tốn thời gian và công sức nhỉ?

Mình đã gửi file giả định ở trên rồi mà bạn. Ngay từ đầu mình quên không gửi file nên mong bạn thông cảm. Vấn đề trên nhờ các bạn giúp đỡ mình đã xử lý được rồi ạ

Giúp đỡ sắp xếp lại dữ liệu theo cột ngày tháng năm bằng vba (2 người xem)

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

Thành viên hoạt động

＿/＿/＿/＿/＿/＿/＿/

Thành viên hoạt động

＿/＿/＿/＿/＿/＿/＿/

Thành viên tiêu biểu

Thành viên hoạt động

Zalo 0986997214

Thành viên hoạt động

＿/＿/＿/＿/＿/＿/＿/

Zalo 0986997214

＿/＿/＿/＿/＿/＿/＿/

Thành viên hoạt động

File đính kèm

Thành viên gạo cội

＿/＿/＿/＿/＿/＿/＿/

Thành viên gạo cội

Thành viên hoạt động

Zalo 0986997214

File đính kèm

Thành viên gạo cội

＿/＿/＿/＿/＿/＿/＿/

Thành viên hoạt động

Đếm ngược thời gian