CHÀO MỌI NGƯỜI thân mếm!
Làm sao để lọc nếu tên hàng đó xuất hiện >= 3 lần trở lên thì lấy 3 dòng trên cùng . Còn <3 lần thì lấy chính nó. và code có chổ để thay thế số lần . để sau này mình muốn 4 hoặc 5 lần thay đổi cho tiện.Mình xin cảm ơn !
Bạn xài tạm cái ni, trong khi chờ những dao mổ ưu việt hơn:
PHP:
Sub Loc3DongDau()
Dim MyAdd As String, NO_1 As String
Dim Cls As Range, Rng As Range, sRng As Range, Arr()
Dim Rws As Long, J As Integer, W As Integer, Cot As Integer
Rws = [B5].CurrentRegion.Rows.Count
Set Rng = [B4].Resize(Rws)
ReDim Arr(1 To Rws, 1 To 4)
[H5].Resize(Rws, 4).Value = ""
For Each Cls In Range([B5], [B5].End(xlDown))
If InStr(NO_1, Cls.Value) Then
Else
NO_1 = NO_1 & Cls.Value
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
J = J + 1: W = W + 1
For Cot = 1 To 4
Arr(W, Cot) = sRng.Offset(, Cot - 1).Value
Next Cot
If J = 3 Then
Exit Do
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
J = 0
End If
End If
Next Cls
If W Then
[H5].Resize(W, 4).Value = Arr(): Randomize
[H4:k4].Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End If
End Sub
CHÀO MỌI NGƯỜI thân mếm!
Làm sao để lọc nếu tên hàng đó xuất hiện >= 3 lần trở lên thì lấy 3 dòng trên cùng . Còn <3 lần thì lấy chính nó. và code có chổ để thay thế số lần . để sau này mình muốn 4 hoặc 5 lần thay đổi cho tiện.Mình xin cảm ơn ! View attachment 242897
Sub chuyendulieu()
Const so As Long = 3 'thay so o day
Dim arr, i As Long, a As Long, kq, dk As String, b As Long, dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
arr = .Range("B5:E18").Value
ReDim kq(1 To UBound(arr), 1 To 4)
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
dic.Add dk, 1
a = a + 1
kq(a, 1) = dk
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
Else
b = dic.Item(dk)
If b < so Then
a = a + 1
kq(a, 1) = dk
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
End If
b = b + 1
dic.Item(dk) = b
End If
Next i
.Range("h5:K1000").ClearContents
.Range("h5:k5").Resize(a).Value = kq
End With
End Sub
CHÀO MỌI NGƯỜI thân mếm!
Làm sao để lọc nếu tên hàng đó xuất hiện >= 3 lần trở lên thì lấy 3 dòng trên cùng . Còn <3 lần thì lấy chính nó. và code có chổ để thay thế số lần . để sau này mình muốn 4 hoặc 5 lần thay đổi cho tiện.Mình xin cảm ơn ! View attachment 242897
Sub Loc()
Dim arrTmp, arrKq, time
Dim i As Long, J As Long, endR As Long, c As Long, d As Long
Application.ScreenUpdating = False
time = Timer()
endR = Range("B" & Rows.Count).End(xlUp).Row
arrTmp = Range("A5:E" & endR).Value
For i = 5 To endR
arrTmp(i - 4, 1) = WorksheetFunction.CountIf(Range("B5:B" & i), Range("B" & i))
Next
ReDim arrKq(1 To UBound(arrTmp), 1 To 4)
For i = 1 To UBound(arrTmp)
If arrTmp(i, 1) <= 3 Then
d = d + 1
For c = 1 To 4
arrKq(d, c) = arrTmp(i, c + 1)
Next
End If
Next
Range("H5:K" & endR).ClearContents
Range("H5").Resize(d, 4).Value = arrKq
Range("H2") = Timer() - time
Application.ScreenUpdating = True
End Sub
Trong đó tôi có tính và ghi thời gian chạy code vào cell H2.
Tiện thể, so sánh thời gian chạy của 3 sub trong thớt (cho vui thôi chứ không có ý gì):
Sub Loc(): 0,0000000 giây -> Không biết có nhầm không, chứ sao nhanh thế
Sub chuyendulieu(): 0,0078125 giây
Sub Loc3DongDau(): 0,0234375 giây
Để so sánh, tôi mở file lên, chạy 1 sub, xóa dữ liệu vùng kết quả, chỉ để lại thời gian chạy, lưu file, đóng lại. Cứ thế lần lượt cho 2 sub còn lại.
À quên, tôi đã thêm Application.ScreenUpdating = False cho cả 3 sub.
Sub Loc()
Dim arrTmp, arrKq, time
Dim i As Long, J As Long, endR As Long, c As Long, d As Long
Application.ScreenUpdating = False
time = Timer()
endR = Range("B" & Rows.Count).End(xlUp).Row
arrTmp = Range("A5:E" & endR).Value
For i = 5 To endR
arrTmp(i - 4, 1) = WorksheetFunction.CountIf(Range("B5:B" & i), Range("B" & i))
Next
ReDim arrKq(1 To UBound(arrTmp), 1 To 4)
For i = 1 To UBound(arrTmp)
If arrTmp(i, 1) <= 3 Then
d = d + 1
For c = 1 To 4
arrKq(d, c) = arrTmp(i, c + 1)
Next
End If
Next
Range("H5:K" & endR).ClearContents
Range("H5").Resize(d, 4).Value = arrKq
Range("H2") = Timer() - time
Application.ScreenUpdating = True
End Sub
Trong đó tôi có tính và ghi thời gian chạy code vào cell H2.
Tiện thể, so sánh thời gian chạy của 3 sub trong thớt (cho vui thôi chứ không có ý gì):
Sub Loc(): 0,0000000 giây -> Không biết có nhầm không, chứ sao nhanh thế
Sub chuyendulieu(): 0,0078125 giây
Sub Loc3DongDau(): 0,0234375 giây
Để so sánh, tôi mở file lên, chạy 1 sub, xóa dữ liệu vùng kết quả, chỉ để lại thời gian chạy, lưu file, đóng lại. Cứ thế lần lượt cho 2 sub còn lại.
À quên, tôi đã thêm Application.ScreenUpdating = False cho cả 3 sub.
Code của bạn có sử dụng hàm CountIf. Hiệu quả của hàm này tuỳ thuộc vào số dòng dữ liệu và độ đơn giản của dữ liệu (1 ký tự so rất nhanh, 10 ký tự là chuyện khác).
Code bài #2 (dùng Find) là loại code căn bản. Không thể đem so hiệu quả.
Code bài #3 dùng đít sần thì phải chịu gánh nặng của nó. Đít sần sẽ chứng minh hiệu quả khi dữ liệu rất nhiều và mã cần so sánh khá phức tạp.
Tuy nhiên, nếu tôi không lầm về thớt thì cái project của y/thị cũng không có dữ liệu lớn. Và như vậy thì code của bạn đủ xài cho y/thị rồi.
Đít sần: cũng như bài toán giá giá thành sản xuất. Phí gồm hai loại, phí cố định và phí lưu động.
Phí cố định là hằng số. Phí lưu động là tỷ lệ (hoặc là hàm số) của số lượng.
Số lượng sản xuất càng nhiều thì giá thành càng giảm.
Code của bạn có sử dụng hàm CountIf. Hiệu quả của hàm này tuỳ thuộc vào số dòng dữ liệu và độ đơn giản của dữ liệu (1 ký tự so rất nhanh, 10 ký tự là chuyện khác).
Code bài #2 (dùng Find) là loại code căn bản. Không thể đem so hiệu quả.
Code bài #3 dùng đít sần thì phải chịu gánh nặng của nó. Đít sần sẽ chứng minh hiệu quả khi dữ liệu rất nhiều và mã cần so sánh khá phức tạp.
Tuy nhiên, nếu tôi không lầm về thớt thì cái project của y/thị cũng không có dữ liệu lớn. Và như vậy thì code của bạn đủ xài cho y/thị rồi.
Đít sần: cũng như bài toán giá giá thành sản xuất. Phí gồm hai loại, phí cố định và phí lưu động.
Phí cố định là hằng số. Phí lưu động là tỷ lệ (hoặc là hàm số) của số lượng.
Số lượng sản xuất càng nhiều thì giá thành càng giảm.
Kết quả thử ~9000 dòng dữ liệu kiểu thế này thì:
Sub Loc(): 2,8671875 giây
Sub chuyendulieu(): 0,3906250 giây
Sub Loc3DongDau(): 0,4414062 giây
Quả là dữ liệu lớn thì dic vô địch, còn code của tôi thành vô địch... chậm.
Sub chuyendulieu()
Const so As Long = 3 'thay so o day
Dim arr, i As Long, a As Long, kq, dk As String, b As Long, dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
arr = .Range("B5:E18").Value
ReDim kq(1 To UBound(arr), 1 To 4)
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
dic.Add dk, 1
a = a + 1
kq(a, 1) = dk
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
Else
b = dic.Item(dk)
If b < so Then
a = a + 1
kq(a, 1) = dk
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
End If
b = b + 1
dic.Item(dk) = b
End If
Next i
.Range("h5:K1000").ClearContents
.Range("h5:k5").Resize(a).Value = kq
End With
End Sub
