Vấn đề sắp xếp dữ liệu từ dưới lên trên vẫn giữ nguyên cấu trúc.

[Ếch Xanh]

Kính thưa với các Thầy Cô,
Tôi có cơ sở dữ liệu, vì những lý do cần xóa 1 vài dòng nên tạo những dòng trống. Tôi muốn sắp xếp lại bằng cách dồn hàng từ dưới lên trên (không phải sort theo ABC), chỗ nào có khoảng trống thì ở dưới dồn lên thôi.
Vậy cho hỏi có ai có Code này không?

 

[boyxin]

Kính thưa với các Thầy Cô,
Tôi có cơ sở dữ liệu, vì những lý do cần xóa 1 vài dòng nên tạo những dòng trống. Tôi muốn sắp xếp lại bằng cách dồn hàng từ dưới lên trên (không phải sort theo ABC), chỗ nào có khoảng trống thì ở dưới dồn lên thôi.
Vậy cho hỏi có ai có Code này không?

MỘT GIẢI PHÁP:

Sub Macro1()
Dim Arr(), ArrKQ(1 To 600, 1 To 6)
Dim i As Byte, j As Byte, s As Byte, dk As Boolean
Arr = [a7].Resize([a65535].End(xlUp).Row - 6, 6).Value
s = 0
For i = 1 To UBound(Arr())
    dk = False
    For j = 1 To 6
        If Arr(i, j) <> "" Then dk = True
    Next
    If dk = True Then
        s = s + 1
        For j = 1 To 6
            ArrKQ(s, j) = Arr(i, j)
        Next
    End If
Next
[a7].Resize([a65535].End(xlUp).Row - 6, 6).ClearContents
[a7].Resize(s, 6) = ArrKQ
End Sub

Cách này nếu có bị đụng hàng với bác nào đã đưa lên topic thì em xin hãy thông cảm - cùng ý tưởng thôi (em chưa đọc hết các bài trong topic này mà )

Mời các bác xem và cho ý kiến để em có thể tiến bộ hơn

 

[Ếch Xanh]

MỘT GIẢI PHÁP:

Sub Macro1()
Dim Arr(), ArrKQ(1 To 600, 1 To 6)
Dim i As Byte, j As Byte, s As Byte, dk As Boolean
Arr = [a7].Resize([a65535].End(xlUp).Row - 6, 6).Value
s = 0
For i = 1 To UBound(Arr())
dk = False
For j = 1 To 6
If Arr(i, j) <> "" Then dk = True
Next
If dk = True Then
s = s + 1
For j = 1 To 6
ArrKQ(s, j) = Arr(i, j)
Next
End If
Next
[a7].Resize([a65535].End(xlUp).Row - 6, 6).ClearContents
[a7].Resize(s, 6) = ArrKQ
End Sub

Cách này nếu có bị đụng hàng với bác nào đã đưa lên topic thì em xin hãy thông cảm - cùng ý tưởng thôi (em chưa đọc hết các bài trong topic này mà )

Mời các bác xem và cho ý kiến để em có thể tiến bộ hơn

Thật tình mà nói về mảng trong VBA em chưa biết mô tê gì hết đó anh KHẢI ơi. Cám ơn Anh đã hướng dẫn bài này cho em.

Anh đang giả định ArrKQ(1 To 600, 1 To 6), thế có phải 600 là hàng và 6 là cột hay không? Nếu vượt quá 10.000 dòng code này có bị nặng không? Vậy có thể thay ArrKQ(1 To 10000, 1 To 6) hay không?

 

[boyxin]

1) Anh đang giả định ArrKQ(1 To 600, 1 To 6), thế có phải 600 là hàng và 6 là cột hay không?

2.1) Nếu vượt quá 10.000 dòng code này có bị nặng không?

2.2) Vậy có thể thay ArrKQ(1 To 10000, 1 To 6) hay không?

1) Chính xác: ArrKQ(1 To 600, 1 To 6) ~ mảng 600 dòng x 6 cột

2.1) Vấn đề này phụ thuộc số phần tử của mảng chứa dữ liệu và dữ liệu đó là kiểu gì

2.2) Có thể thay ArrKQ(1 To 10000, 1 To 6) hoặc nhiều dòng hơn, nhiều cột hơn. Khi đó cần khai báo lại biến chạy, trong code này: biến chạy cần khai báo lại là i, s, j As integer (<= 32767) hoặc long (<=2147483467) ...

Đã test với mảng trên 65.000 dòng và dữ liệu đủ 60.000 dòng:Timer(end) - Timer(begin) = 2.1875s trên máy tính có cấu hình như sau

------------
Biết tới đâu, nói tới đó, có gì thiếu sót mong các bác góp ý kiến thêm nhé!
​

 

[sealand]

Mình tham gia 1 cách:

Sub xep()
 Dim Rg As Range
  Application.ScreenUpdating = False
   Set Rg = Sheet1.Range("A8", Sheet1.[a65536].End(xlUp).Offset(, 7))
     Rg.Columns(7).Formula = "=IF(RC[-6]<>"""",MAX(R7C7:R[-1]C)+1,""A"")"
      Rg.Sort Key1:=Range("G8"), Order1:=xlAscending, Header:=xlNo
    Rg.Columns(7).ClearContents
   Set Rg = Nothing
  Application.ScreenUpdating = True
End Sub

Nhờ Boyxin test giùm với dữ liệu lớn và cùng cấu hình máy với. Cái quan trọng là tìm ra phương pháp tối ưu thôi.

 

[boyxin]

Mình tham gia 1 cách:

Sub xep()
 Dim Rg As Range
  Application.ScreenUpdating = False
   Set Rg = Sheet1.Range("A8", Sheet1.[a65536].End(xlUp).Offset(, 7))
     Rg.Columns(7).Formula = "=IF(RC[-6]<>"""",MAX(R7C7:R[-1]C)+1,""A"")"
      Rg.Sort Key1:=Range("G8"), Order1:=xlAscending, Header:=xlNo
    Rg.Columns(7).ClearContents
   Set Rg = Nothing
  Application.ScreenUpdating = True
End Sub

Nhờ Boyxin test giùm với dữ liệu lớn và cùng cấu hình máy với. Cái quan trọng là tìm ra phương pháp tối ưu thôi.

Khi test với dữ liệu vài chục dòng thì code của sealand chạy rất nhanh, nhưng với dữ liệu lớn

1) code boyxin
Vùng: chứa 5000 dòng có dữ liệu Timer(end) - Timer(begin) = 0.140625 s
Vùng: chứa 10000 dòng có dữ liệu Timer(end) - Timer(begin) = 0.265625 s
Vùng: chứa 20000 dòng có dữ liệu Timer(end) - Timer(begin) = 0.515625 s
Vùng: chứa 40000 dòng có dữ liệu Timer(end) - Timer(begin) = 1 s
Vùng: chứa 60000 dòng có dữ liệu Timer(end) - Timer(begin) = 1.484375 s

2) code sealand
Vùng: chứa 5000 dòng có dữ liệu Timer(end) - Timer(begin) = 5.828125 s
Vùng: chứa 10000 dòng có dữ liệu Timer(end) - Timer(begin) = 64.78125 s
Hổng giám đâuEm hông muốn ri sẹt

 

[sealand]

Đúng rồi, chính vì mình nghi ngờ phương thức Sort của Exc và nhờ Boyxin Test.
Nhưng code của Boyxin nên sửa câu lệnh
a7].Resize([a65535].End(xlUp).Row - 6, 6).ClearContents
thành

[a7].Resize([a65535].End(xlUp).Row - 6, 6).SpecialCells(xlCellTypeConstants, 23).ClearContents
Như vậy mới giữ nguyên được cấu trúc

Và thêm đoạn code màu đỏ như code dưới sẽ bớt số lần kiểm tra rất nhiều
For j = 1 To 6
If Arr(i, j) <> "" Then dk = True : Exit for
Next

 

[boyxin]

Nhưng code của Boyxin nên sửa câu lệnh
a7].Resize([a65535].End(xlUp).Row - 6, 6).ClearContents
thành

[a7].Resize([a65535].End(xlUp).Row - 6, 6).SpecialCells(xlCellTypeConstants, 23).ClearContents
Như vậy mới giữ nguyên được cấu trúc

ClearContents đâu có làm mất: Cấu trúc, định dạng ... (Bỏ định dạng cột A cũng rút ngắn thời gian chút ít).

Cảm ơn sealand đã góp ý

Và thêm đoạn code màu đỏ như code dưới sẽ bớt số lần kiểm tra rất nhiều
For j = 1 To 6
If Arr(i, j) <> "" Then dk = True : Exit for
Next

 

[sealand]

Boyxin không tính đến nếu vùng nào đó có công thức thì sao (Dũ liệu nhiều thì sao kiểm tra nổi), tốt nhất ta cứ sử lý chắc ăn thì hơn.

 

[boyxin]

Đúng rồi, chính vì mình nghi ngờ phương thức Sort của Exc và nhờ Boyxin Test.

Code chậm không vì nguyên nhân sort của excel mà chính tại chỗ gán công thức vào cells và thực hiện lệnh trong công thức

Boyxin không tính đến nếu vùng nào đó có công thức thì sao (Dũ liệu nhiều thì sao kiểm tra nổi), tốt nhất ta cứ sử lý chắc ăn thì hơn.

Nếu do công thức mà tạo ra dong trông như vậy thì mình nghĩ sẽ vô cùng khó (không muốn nói là không thể) dồn theo kiểu này, đặc biệt trong công thức lại tham chiếu bằng địa chỉ tương đối (không có đô la ^$^ )