Mình mới học VBA, Minh lập trình File này để sử dụng, mà mấy hôm này cứ làm đi làm lại mà không được ở bước lọc dữ liệu (FilterData). Mình post file len GPE mong anh em giúp đở với. Thanhk GPE
Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở đầu Loc lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở giữa Loc lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở cuối Loc lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
Mình mới học VBA, Minh lập trình File này để sử dụng, mà mấy hôm này cứ làm đi làm lại mà không được ở bước lọc dữ liệu (FilterData). Mình post file len GPE mong anh em giúp đở với. Thanhk GPE
Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
Ở đầu Loc lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
Ở giữa Loc lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
Ở cuối Loc lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
Lấy hàng có V2 nhỏ nhất (hàng 7 có V2= -5.94)
Lấy hàng có V2 lớn nhất (hàng 52 có V2= 6.09)
HTML:
Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở Loc đầu, lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở Loc giữa, lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở Loc cuối, lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
(chú ý: Loc ở đây không phải là lọc mà là 1 ký hiệu đại diện, nghĩa của nó là mặt cắt)
Mình có ghi chú bảng tính trong file như sau:
Cột Loc (Cột có tên Lốc là cột D) là vị trí mặt cắt của Beam, vị trí cắt này không phải lúc nào cũng tăng lên theo bội số 0.5, mà là 1 số nào đó
VD Loc (Loc ở đây được hiểu là mặt cắt) của B1 là: 0 0.5 1 1.5 2 … 6 (đầu Loc la 0 va cuối Loc là 6)
có nghĩa là đối với Beam B1 thì ta có các Loc (mặt cắt) đi từ đầu bên này đến đầu bên kia, Ví dụ như ta có B1 là cây thước gạch dài 6 (cm). (Loc di từ 0 đến 6)
0 , 0.5, 1 , 1.5, 2, 2.5, 3 , 3.5, 4, 4.5, 5, 5.5, 6 đó là các khoảng cách mà ta dùng dao chặt cây thước gạch ấy ra (mặt cắt)
Mỗi lần cắt (tương ứng vói 1 vết đứt - tương ướng với 1 hàng số liệu trên bảng tính) cho ra M3 tương ứng
Nếu cây thước gạch đó chia là 4 phần, 6/4=1.5 cm, thì phần 1/4 đầu tiên Loc (từ >= 0 đến <1.5) thì gọi là phần Loc đầu tiên
1/4 đoạn cuối (từ > 4.5 đến <=6) gọi là Loc cuối. Còn lại 2/4 ở giữa gọi là Loc giữa.
Cái đó là cái khó nhất vì đối với mỗi loại Beam ta phải phân đoạn cho nó để lấy số liệu.
Hi vong cac bạn sẽ hiểu và giúp mình. thanks
Yêu cầu của mình là xóa hết hàng và để lại các hàng thỏa điều kiện
VD cụ thể là hàng số liệu tương ứng với hàng 7,28 hoăc 29, 53, 52 cho Beam B1
còn B2, B3, B5, B6 là tương tự như vậy mà để lại.
Có nghĩa là với Beam B1 cụ thể là xóa hết còn lại 3 hàng,
hàng 1 là hàng số 7 (khi chưa xóa)
hàng 2 là hàng 28 hoăc 29 (khi chưa xóa)
hàng 3 là hàng 53 (khi chưa xóa)
(Nhưng ô mà mình tô màu xanh va đậm là nhưng ô thỏa điều kiện và ta giữa lại hàng chứa nhưng o đó. còn lại là xóa)
Tương tự Beam B2 cũng còn lại 3 hàng.
Mình đã làm bằng tay đối với Beam B1, B2, B3, Và tô đậm màu xanh các ô thỏa mãn điều kiện ở Beam B4 có ghi chú từng trường hợp. Có lẽ anh ThuNghi giờ sẽ hiểu ý mình. Và mong anh ThuNghi giúp em với. ( chú ý đùng bấm nút ClearData, sẽ xóa hết nhưng ghi chú đó của mình)
Nói thì nhiều cho các bạn dẻ hình dung, chứ tốm lại có 1 câu 1 thôi.
Làm sao cho mỗi phần tử Beam chỉ để lại 3 dòng, có giá trị tuyệt đối lớn nhất ở 3 vị trị: Đầu , Giưu và Cuối.
Anh chi em GPE với!
Làm sao cho mỗi phần tử Beam chỉ để lại 3 dòng, có giá trị tuyệt đối lớn nhất ở 3 vị trị: Đầu , Giưu và Cuối. còn lại là xóa hết.
file gởi kềm ở #3
Yêu Cầu Lọc Theo điều kiện( file gởi kềm trong #1)
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở Loc đầu, lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở Loc giữa, lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở Loc cuối, lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
Hai bạn chạy thử macro sau & cho ý kiến, giúp nha!
PHP:
Option Explicit
Sub DestinationBlock()
Dim eRow As Long, fRow As Long, lRow As Long, sRow As Long
Dim rRng As Range, Rng As Range
Dim GPE_Address As String
Sheets("Beam").Select: Application.ScreenUpdating = False
eRow = [B65432].End(xlUp).Row
Sheets("Data").Select: Range([a2], Cells(eRow, "H")).Clear
Sheets("Beam").Select
With Sheets("Beam").Range("B6:B" & eRow)
sRow = 6
Do
Set Rng = .Find(what:=Cells(sRow, "b"), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
Set rRng = Rng
GPE_Address = Rng.Address
Do
Set rRng = Union(rRng, Rng)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> GPE_Address
End If
If Not rRng Is Nothing Then
MsgBox rRng.Offset(, -1).Resize(, 6).Address, , rRng.Rows.Count + sRow
sRow = rRng.Rows.Count + sRow
Else: End If
If sRow > eRow Then Exit Do
Loop
End With
End Sub
(Mới nữa chặng thôi; nhưng nếu đúng thì sẽ là 10% còn lại để đến đích mà thôi
Vì cái macro thứ hai ở trên sẽ xài được, không việc gì âu lo!)
Xác định dòng đầu (vt1), dòng cuối (vt2) của mỗi Beam chuẩn rồi
Xét theo M3, (cột có tiêu đề là M3) việc cần làm tiếp theo là
1- Tìm vị trí của giá trị MAX của vùng (vt1:vt2) vtmax
2- Tìm vị trí của giá trị MIN của vùng đầu (vt1:vtmax) vtmin1
3- Tìm vị trí của giá trị MIN của vùng sau (vtmax:vt2) vtmin2
4- Xét từ cuối lên trên, Mỗi Beam giữ lại 3 dòng ứng với các giá trị vtmin1, vtmax, vtmin2 vừa tìm được thế là OK
File Tổng hộp các trường hợp mà Data có thể sẫy ra.
Mình đã tổng hợp 1 trường hợp chung nhất cho Data. Và cũng kềm theo cách làm và ghi chú rõ ràng trong file. Có giải thích.
Có sự phân biệt giữa các Beam
Vd: Beam B4 - Story L1
Beam B4 - Story L2 ... vv..
Mình phân tích file của bạn đây. (file cua ban trong bai #42)
Thực chât file của minh vừa send là bao hàm cả file của bạn rồi.
File bạn:
Ở sheet kiemtra01 thực tế là 1 Beam B6/TR (Beam B6 thuộc tầng trệt)
Ở sheet kiemtra02 thực tế là 2 Beam B6/TR và B6/LAU1
Nhưng Số liệu của bạn do bạn chỉnh sửa ngẫu nhiên nên xẫy ra trường hợp bị phân đoạn, nghĩa là Phần tử B6/TR bị đứt làm hai. B6/TR từ hàng 2 -> 15
Tiếp theo B6/TR từ hàng hàng 29 -> 33
Nhưng vì nó cùng 1 tên là B6/TR nên nó thuộc 1 phần tử. Nếu để số liệu như vậy vô tình ta lam cho 1 phần tử trở nên không trọn vặn, VD như Thằng Cu tên Nguyen Văn B6/TR, có Cái Đầu và cái Mình ở trên, Rồi sau đó đến bộ phận cơ thể của Nguyen Van B6/LAU1, tiếp theo mới đến cái chân Của Nguyen Van B6/TR...
Thế thì Nguyen Van B6/TR làm sao sống nổi. (Bị đứt như vậy là chết chắc)-> Không thể xẫy ra
Vì vậy bạn phải làm 1 thao tác nối Cái đầu (Đầu Loc) và Cái Mình (Giữa Loc) với Cái chân (Cuối Loc) lại. thế thì Nguyen Van B4/TR sẽ sống lại. khi đó nó sẽ tự có các Loc tăng lên từ nhỏ đến lớn cho bạn chọn.
Cụ thể (mình đã hiểu ý bạn) nên theo như mình nói ở bài #45, bạn hãy Sort Data của Kiemtra02 theo 1.Story 2.Beam 3.Loc
Sẽ thấy xuất hiện 2 loại Beam B4/TR -> có đầy đủ cac Loc
và B4/LAU1 -> có đầy đủ các Loc
Chú ý: Số liệu đúng từ phần mền xuất ra luôn có Loc tăng từ nhỏ đến lớn, bạn không sợ có trường hợp nào khác.
Chờ mình 1 tí, mình sẽ vẽ hình minh họa vì sao lại cùng Loc = 0 lại có 2 giá trị M3...
Option Explicit
Sub DestinationBlock()
Dim eRow As Long, fRow As Long, lRow As Long, sRow As Long
Dim rRng As Range, Rng As Range
Dim GPE_Address As String
Sheets("Beam").Select: Application.ScreenUpdating = False
eRow = [B65432].End(xlUp).Row
Sheets("Data").Select: Range([a2], Cells(eRow, "H")).Clear
Sheets("Beam").Select
For sRow = 6 To eRow
Cells(sRow, "I").Value = Cells(sRow, 1) & Cells(sRow, "B").Value
Next sRow
With Sheets("Beam").Range("I6:I" & eRow)
sRow = 6
Do
Set Rng = .Find(what:=Cells(sRow, "I"), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
Set rRng = Rng
GPE_Address = Rng.Address
Do
Set rRng = Union(rRng, Rng)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> GPE_Address
End If
If Not rRng Is Nothing Then
TimMax rRng.Cells(1, 1).Row, rRng.Offset(rRng.Rows.Count).Row - 1
sRow = rRng.Rows.Count + sRow
Else: End If
If sRow > eRow Then Exit Do
Loop
End With
Range([i6], Cells(eRow, "I")).Clear
End Sub
File của bạn Dựa trên nguyên tắc, chọn và to hồng các M3 thỏa yêu cẩu và Ẩn các hàng còn lại. Nhưng bạn lại dùng vùng tạm để ghi dữ liệu tính toán. Cái này cũng có thể được nến dữ liệu o vùng tạm là trống, chứ nếu ở đó có công thức thì xem như bị đè mất công thức , hihi.
Mình đã kiểm tra . OK lắm thanks ban nhiều ! Tốt độ sử lý cũng rất nhanh.
Góp ý bạn pmhoang về sub ShortData của bạn :
Bạn tìm điều kiện và delete các dòng thừa trong vòng lặp cho nên bị chậm.
Vòng lặp chỉ tìm điều kiện thôi.
Khi delete thì thực hiện 1 lần cho tất cả các dòng này, thời gian sẽ nhanh hơn.
Ví dụ như sub sau :
PHP:
Sub short_data()
Columns(7).ClearContents
For N = 6 To [F65500].End(xlUp).Row
If Cells(N, 6).Font.ColorIndex = 7 Then
Cells(N, 7) = 1
End If
Next N
Range([A6], Cells([F65500].End(xlUp).Row, "g")).Select
Selection.Sort Key1:=[G6], Order1:=xlAscending, _
Key2:=[A6], Order2:=xlAscending, Key3:=[B6], Order3:=xlDescending _
Range(Cells([G65500].End(xlUp).Row + 1, "g"), _
Cells([F65500].End(xlUp).Row, "g")).EntireRow.Delete
Range([G6], Cells([F65500].End(xlUp).Row, "g")).ClearContents
End Sub
Bạn thử xem.
(Sub này dựa trên dữ liệu bạn đang có nên chưa tối ưu, nhưng cũng đã nhanh hơn ShortData của bạn rồi đó. Bạn chỉnh sửa lại theo ý bạn thì nó còn nhanh hơn).
Góp ý bạn pmhoang về sub ShortData của bạn :
Bạn tìm điều kiện và delete các dòng thừa trong vòng lặp cho nên bị chậm.
Vòng lặp chỉ tìm điều kiện thôi.
Khi delete thì thực hiện 1 lần cho tất cả các dòng này, thời gian sẽ nhanh hơn.
Ví dụ như sub sau :
PHP:
Sub short_data()
Columns(7).ClearContents
For N = 6 To [F65500].End(xlUp).Row
If Cells(N, 6).Font.ColorIndex = 7 Then
Cells(N, 7) = 1
End If
Next N
Range([A6], Cells([F65500].End(xlUp).Row, "g")).Select
Selection.Sort Key1:=[G6], Order1:=xlAscending, _
Key2:=[A6], Order2:=xlAscending, Key3:=[B6], Order3:=xlDescending _
Range(Cells([G65500].End(xlUp).Row + 1, "g"), _
Cells([F65500].End(xlUp).Row, "g")).EntireRow.Delete
Range([G6], Cells([F65500].End(xlUp).Row, "g")).ClearContents
End Sub
Bạn thử xem.
(Sub này dựa trên dữ liệu bạn đang có nên chưa tối ưu, nhưng cũng đã nhanh hơn ShortData của bạn rồi đó. Bạn chỉnh sửa lại theo ý bạn thì nó còn nhanh hơn).
Nếu đã for next thì tại sao không delete row luôn mà phải gán =1 rồi sort, thường cái này nên delete từ dưới lên.
PHP:
Sub shortdata()
Dim ERow As Long, iR As Long
Sheets("Beam").Select
ERow = [F65500].End(xlUp).Row
For iR = ERow To 6 Step -1
If Cells(N, 6).Font.ColorIndex <> 7 Then
Rows(N).Delete Shift:=xlUp
End If
Next iR
End Sub
Thường thì chương trình được viết sao cho (1) đơn giản, ngắn gọn, (2) dễ hiểu, dễ hình dung, (3) thực thi nhanh, (4) … Đạt được tất cả thì rất tốt, nhưng khó. Khi đó phải chọn thứ nào được ưu tiên hơn. Việc này tùy yêu cầu đề bài, tùy người, tùy năng lực máy,… Sau này tốc độ máy tính đã nhanh hơn xưa nhiều nên xu hướng (1) (2) lấn át (3) (nói đúng ra thì sự chậm hơn của (1) (2) so với (3) là không thấy rõ, chấp nhận được). Tuy nhiên có những lúc sự chậm hơn là đáng kể, cho nên việc viết lại thuật giải sao cho cải thiện tốc độ thực thi lại trở thành việc cần thiết. Tôi thấy lệnh Delete Row thực hiện rất chậm. Trường hợp có không nhiều dòng cần delete thì có thể delete ngay trong vòng lặp, nhưng nếu số dòng cần delete khá nhiều thì thời gian thực thi sẽ đến mức đáng kể. Cho nên tôi gom các dòng cần delete lại để rồi thực hiện delete một lần mà thôi. Làm thế này thì cũng có cái dở là sử dụng cột phụ, giải thuật thì khó hiểu hơn so với delete trong vòng lặp, nhưng thỏa nguyện vọng về tốc độ thực thi.
Tôi thấy lệnh Delete Row thực hiện rất chậm. Nếu số dòng cần delete khá nhiều thì thời gian thực thi sẽ đến mức đáng kể. Cho nên tôi gom các dòng cần delete lại để rồi thực hiện delete một lần mà thôi. Làm thế này thì cũng có cái dở là sử dụng cột phụ, giải thuật thì khó hiểu hơn so với delete trong vòng lặp, nhưng thỏa nguyện vọng về tốc độ thực thi.
Cái này thì mỗi lần lặp VB phải thực hiện lệnh [F65500].End(xlUp).Row điều này chỉ khi nào [F65500].End(xlUp).Row thay đổi thì được, còn [F65500].End(xlUp).Row là 1 hằng số thì cách này sẽ làm VB Run chậm hơn là code sau:
Chiều hôm qua, khi kiểm tra lại, phát hiện ra chổ sai đó, và sửa lại cho đúng là: (Thanks ThuNghi)
PHP:
If Cells(n, "A").Value = Cells(n + 1, "A").Value And Cells(n, "B").Value = _
Cells(n + 1, "B").Value Then
n = n + 1
Else
RowCuoiBeam = n
If RowDauBeam = 1 Then
RowDauBeam = 6
End If
2. Đoạn code ShortData của bạn phai sửa lại N thành iR như sau:
PHP:
Sub shortdata_ThuNghi()
Dim ERow As Long, iR As Long
Sheets("Beam").Select
ERow = [F65500].End(xlUp).Row
For iR = ERow To 6 Step -1
If Cells(iR, 6).Font.ColorIndex <> 7 Then
Rows(iR).Delete Shift:=xlUp
End If
Next iR
End Sub
Nhưng xêm ra tốc độ Delete trong For Next cũng không khác hơn trong Do Loop như code của mình. Nó rất chậm. Cach của bạn lypt thì dùng sort cot "G"=1 và Delete 1 vùng sau khi sort là rất nhanh, nhưng phải dùng vùng tạm. Còn hướng đi của ChanhTQ thì set từng vùng 1, rồi Union, cứ tiếp tục Union như thế ta se có 1 Union gồm tất cả các hàng sẽ delete và thực hiện 1 lần delete. Đó là cách mà tôi tự hiểu... chứa trong Code của ChanhTQ thì chưa hiểu lắm về [Ai]. mong bạn CTQ hoàn chỉnh nó thành 1 sub nhe.
Nếu nhìn qua thì thấy cái này hay. nhưng chưa hiểu lắm về [Ai] bạn có thể cụ thể hóa trong Sub ShorData đi. (có phải ý bạn là chọn 1 Union gồm nhiều vùng - tất cả các vùng cần delete rồi delete 1 lần ???
Nếu nhìn qua thì thấy cái này hay. nhưng chưa hiểu lắm về [Ai] bạn có thể cụ thể hóa trong Sub ShorData đi. (có phải ý bạn là chọn 1 Union gồm nhiều vùng - tất cả các vùng cần delete rồi delete 1 lần ???
Mình thay đổi For n= 6 to [F65500].End(xlUp).Row
bằng For n = 6 To eRow VB chỉ tìm giá trị xlUP 1 lần thôi -> sẽ nhanh hơn
Mình thay đổi Set DelRng = Cells(n, 6).EntireRow còn lại Set DelRng = Cells(n, 6) làm như vậy sẽ ít tốn bộ nhớ của VB hơn, vì ở đây bộ nhớ chỉ nhớ 1 Cell, so với EntireRow là 256 Cell
PHP:
Sub ShortData_ChanhTQ_Lypt_Pmh()
Dim DelRng As Range
eRow = [F65500].End(xlUp).Row
For n = 6 To eRow
If Cells(n, 6).Font.ColorIndex <> 7 Then
If DelRng Is Nothing Then
Set DelRng = Cells(n, 6)
Else
Set DelRng = Union(DelRng, Cells(n, 6))
End If
End If
Next n
DelRng.EntireRow.Delete
End Sub
Nhưng chỉ thấy nhanh lên hơn 1 tí. vẫn còn chậm lắm...(chậm hơn đoạn code của lypt - chon vùng tạm - rat nhiều)
Mình nghĩ tại vì Set DelRng = Union(DelRng, Cells(n, 6)) mỗi lần chỉ Union có 1 Cell cho nen công việc Union rất là nhiều. Nếu thay: Set DelRng = Union(DelRng, Vùng giữa 2 giá trị có màu hồng) khi đó khối lượng Union sẽ giảm lại => tốc độ sẽ cao hơn. Mong Lypt và CTQ chuyển thể nó với.
Mình mới tìm ra 1 lệnh chọn vùng không cần vùng phải liên tục miễn sao thỏa điều kiện nào đó. Ơ đây là vùng thỏa điều kiện Cell trống. SpecialCells(xlCellTypeBlanks) Mình đã chỉnh lại Sub của bạn Lypt theo cách này các bạn xem thử cú ưu việt không?
PHP:
Sub short_data_lypt_PMH()
Columns(7).ClearContents
eRow = [F65500].End(xlUp).Row
For n = 6 To eRow
If Cells(n, 6).Font.ColorIndex = 7 Then
Cells(n, 7) = 1
End If
Next n
Set Rng = Range([G6], Cells(eRow, "G")).SpecialCells(xlCellTypeBlanks)
Rng.EntireRow.Delete
Range([G6], Cells(eRow, "g")).ClearContents
End Sub
Nhưng như nếu dùng SpecialCells(xlCellTypeBlanks) được, mình nghĩ sẽ phải có 1 Lệnh tương tự có tác dụng chọn tất cả các vùng khi Cells Format là mặc định, Khi đó ta không dùng vùng tạm nữa, mà chọn trực tiếp vào cột M3. Ta chọn 1 lúc các Cells format = mặc định (không tô màu, không màu hồng). rồi thực hiện Delete 1 lần.
Lây hay mãi vẫn không tìm ra cấu trúc lệnh như suy nghỉ, Các bạn có phương án gì? giúp mình với.
Theo tôi thì không nhanh hơn vì eRow vẫn là “biến” chứ không phải “hằng”. Ta có thể cảm giác được eRow không đổi, nhưng máy thì không có cảm giác đó, máy vẫn nhìn eRow là “biến” và vì vậy khi vòng For quay lại máy vẫn hỏi eRow là bao nhiêu cũng giống như máy hỏi [F65500].End(xlUp).Row là bao nhiêu – 2 cái hỏi này là như nhau. Tôi đã kiểm tra thực tế và không thấy nhanh hơn (mà không thấy nhanh hơn thì : thêm eRow là tốn thêm 1 biến, đồng thời mất thêm một lệnh gán biến đó, lệnh này có mất thời gian nhưng vì chỉ một lệnh nên không cảm nhận thời gian tính này).
Trong trường hợp dữ liệu cụ thể của bạn thì giải thuật của ChanhTQ có chậm hơn của tôi, nhưng trong trường hợp tổng quát thì không như thế đâu nhé, thậm chí có thể nhanh hơn, điều này tùy thuộc vào dữ liệu có tỉ lệ giữa số dòng cần để lại và số dòng phải xóa đi như thế nào.
Theo tôi thì không nhanh hơn vì lệnh làm chậm chính là lệnh “Cells(n, 7) = 1” nằm trong vòng lặp ấy – nhìn thấy đơn giản có 1 dòng lệnh nhưng nó được thực hiện rất nhiều lần theo vòng lặp. Còn cái chỗ bạn đề nghị sửa thì nó không làm chậm chương trình đâu.
mình nghĩ sẽ phải có 1 Lệnh tương tự có tác dụng chọn tất cả các vùng khi Cells Format là mặc định, Khi đó ta không dùng vùng tạm nữa, mà chọn trực tiếp vào cột M3. Ta chọn 1 lúc các Cells format = mặc định (không tô màu, không màu hồng). rồi thực hiện Delete 1 lần.
Chính xác là tôi cũng đang tìm chỗ này đây, nhưng đến giờ vẫn chưa thấy. Trong khi chờ đợi tìm ra thì mời quay lại với chương trình của tôi với một chút cải biên là vẫn dùng vùng tạm nhưng không sử dụng vùng mới (cột G) mà là khai thác vùng đang có với các chú ý nhất định. Cụ thể chọn cột A chẳng hạn, ta thấy cột A là một cột dữ liệu có sẵn và cũng là cột Key1 khi thực hiện Sort dữ liệu. Dữ liệu cột A là Text. Ta tìm một ký tự thỏa điều kiện vừa khác vừa lớn hơn (về thứ tự trong máy, nhỏ hơn cũng được nhưng sắp xếp sẽ khác) so với tất cả các ký tự có trong dữ liệu cột A (ví dụ ký tự “Z”, có thứ tự lớn hơn tất cả ký tự cột A). Tại các dòng cần chừa lại (không delete) ta thêm ký tự này vào trước dữ liệu cột A. Chọn vùng dữ liệu tất cả, sắp xếp dữ liệu theo cột A, tăng dần. Chọn vùng dữ liệu cột A, tìm ký tự này bằng lệnh Find, xác định được vị trí này, xác định được vùng cần xóa dữ liệu và xóa đi các dòng thừa. Nói ra thì dài dòng nhưng thực chất số lệnh trong vòng lặp chỉ có một lệnh là “thêm ký tự Z vào cột A” thay cho lệnh “đặt giá trị 1 ở vùng tạm cột G”; các lệnh khác là nằm ngoài vòng lặp và không ảnh hưởng đáng kể đến tốc độ. Tôi đã kiểm tra thực tế tốc độ chạy không bị chậm hơn (chạy với dữ liệu 10.000 records). Cụ thể Sub :
Trong quá trình bạn tìm các dòng Max, Min1, Min2 (theo Function M3_Bold) rồi tô đậm và tô màu để phân biệt thì bạn có thể kết hợp thêm “Z” vào cột A luôn cũng được; khi đó Short_Data sẽ không có vòng lặp và không bị chậm. Nhưng mà M3_Bold của bạn sẽ bị chậm vì phải gánh thêm lệnh (cái chậm này có khi lại lớn hơn mới chết chứ!). Cuối cùng, những lệnh trong vòng lặp là nguồn chính làm chậm chương trình cho nên chỉ sử dụng những lệnh thật cần thiết trong vòng lặp. Giờ thì đi tìm lệnh chọn vùng “cells format” xem sao! Nếu có sẽ báo cho bạn.
Thôi tôi gán vào 1 cell như lypt và sort là nhanh nhất, tôi đã test với 50.000 row thì chỉ có cách gán và sort lại là nhanh. Tôi đã thử
if true then cells(i,6).clearcontents và sort lại cũng không nhanh = cells(i,7)=1 và sort.
Từ ý của bạn ChanhTQ tôi đã khai thác lệnh Union nhưng có đổi lại điều kiên như sau :
- Theo bạn ChanhTQ thì do Union các dòng cần delete nên số lượng rất nhiều, và lệnh thực thi trong vòng lặp cũng nhiều.
- Tôi đổi lại, sử dụng Union cho những dòng lệnh chừa lại, số lượng sẽ ít hơn nên lệnh thực thi trong vòng lặp sẽ ít hơn.
- Vấn đề là xóa các dòng thừa và chép các dòng để lại như thế nào?
- Tôi đã lấy Union tổng hợp được khi nãy chép vào một vùng trống mới (dưới dòng cuối cùng chẳng hạn), rồi delete tất cả các dòng cũ. Quả nhiên là được. Và nhanh hơn hẳn. Các bạn thử xem nhé.
PHP:
Sub Short_ChanhTQ()
Dim Rng As Range
For n = 6 To [F65500].End(xlUp).Row
If Cells(n, 6).Font.ColorIndex = 7 Then
If Rng Is Nothing Then
Set Rng = Cells(n, 6).EntireRow
Else
Set Rng = Union(Rng, Cells(n, 6).EntireRow)
End If
End If
Next n
Rng.Select
Selection.Copy
Cells([F65500].End(xlUp).Row + 1, "A").Select
ActiveSheet.Paste
Range([A6], Cells(ActiveCell.Row - 1, "A")).EntireRow.Delete
[A6].Select
End Sub
Đến lúc này, mình có câu hỏi ngu ngơ thế này:
Tại sao các bạn lại đi tìm những records đã tô đậm/tô màu thế kia chứ; Trước đây các bạn tìm ra chúng & Format chúng, phải không?
Ý mình muốn nói là đễ tìm nhanh 1 loạt Records nào thì phương thức FIND() vẫn là trên cả tuyệt vời. Càng tuyệt vời hơn nếu chúng là số ít như các bạn thấy các macro bên trên. Sao ta không tiếp tục theo hướng này cái nhỉ?
Đến lúc này, mình có câu hỏi ngu ngơ thế này:
Tại sao các bạn lại đi tìm những records đã tô đậm/tô màu thế kia chứ; Trước đây các bạn tìm ra chúng & Format chúng, phải không?
Ý mình muốn nói là đễ tìm nhanh 1 loạt Records nào thì phương thức FIND() vẫn là trên cả tuyệt vời. Càng tuyệt vời hơn nếu chúng là số ít như các bạn thấy các macro bên trên. Sao ta không tiếp tục theo hướng này cái nhỉ?
Thanks nhiều. Mình sẽ cố gắng kiểm tra.
" & Erow+6-2).value
