Lọc duy nhất ? (1 người xem)

Hoàng Nhật Phương · 3/1/17

Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.

Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

befaint · 3/1/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.

Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

Bạn xem file đính kèm.

Ba Tê · 3/1/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.

Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

Bạn thử chạy Sub này:

PHP:

Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Tem As String
R = ActiveCell.SpecialCells(xlLastCell).Row
sArr = Range("A5:I" & R).Value
ReDim dArr(1 To UBound(sArr) * 7, 1 To 1)
With CreateObject("Scripting.Dictionary")
For I = 1 To UBound(sArr)
    For J = 1 To UBound(sArr, 2)
        If sArr(I, J) <> Empty Then
            Tem = sArr(I, J)
            If Not .Exists(Tem) Then
                K = K + 1
                .Add Tem, ""
                dArr(K, 1) = Tem
            End If
        End If
    Next J
Next I
End With
Range("J5:J10000").ClearContents
Range("J5").Resize(K) = dArr
End Sub

chucuoi92 · 3/1/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.

Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

Hàm Transpose không thể sử lý một chuỗi >255 ký tự, do vậy báo lỗi nhé bạn.
(trong file của bạn có một ô[H1437] có 266 ký tự, xoá thử ô này đi thì sub chạy bình thường.

Hoàng Nhật Phương · 3/1/17

Ahihi,kết quả OK rồi ạ.
Oanh Thơ xin cảm ơn các bạn nhiều nhé.

ôi,bùn ghê nút cảm ơn ẩn đâu mất rồi (T_T)!

ndu96081631 · 3/1/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.

Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

Nếu dữ liệu của bạn khá đặc biệt thì không nên dùng hàm Transpose mà nên viết hàm riêng (nguyên nhân thì bài 4 đã nói rõ)

Mã:

Function ArrayTo2D(ByVal Arr)
  If IsArray(Arr) Then
    ReDim aRet(LBound(Arr) To UBound(Arr), 1 To 1)
    Dim n As Long
    For n = LBound(Arr) To UBound(Arr)
      aRet(n, 1) = Arr(n)
    Next
    ArrayTo2D = aRet
  End If
End Function

Thêm hàm trên vào module của bạn rồi sửa lại đoạn:

Mã:

If IsArray(Arr) Then .Range("J3").Resize(UBound(Arr) + 1).Value = [COLOR=#ff0000]WorksheetFunction.Transpose(Arr)[/COLOR]

Thành:

Mã:

If IsArray(Arr) Then .Range("J3").Resize(UBound(Arr) + 1).Value = [COLOR=#ff0000]ArrayTo2D(Arr)[/COLOR]

là xong

Hoàng Nhật Phương · 3/1/17

ndu96081631 đã viết:
Nếu dữ liệu của bạn khá đặc biệt thì không nên dùng hàm Transpose mà nên viết hàm riêng (nguyên nhân thì bài 4 đã nói rõ)

Mã:

Function ArrayTo2D(ByVal Arr) If IsArray(Arr) Then ReDim aRet(LBound(Arr) To UBound(Arr), 1 To 1) Dim n As Long For n = LBound(Arr) To UBound(Arr) aRet(n, 1) = Arr(n) Next ArrayTo2D = aRet End If End Function

Thêm hàm trên vào module của bạn rồi sửa lại đoạn:

Mã:

If IsArray(Arr) Then .Range("J3").Resize(UBound(Arr) + 1).Value = [COLOR=#ff0000]WorksheetFunction.Transpose(Arr)[/COLOR]

Thành:

Mã:

If IsArray(Arr) Then .Range("J3").Resize(UBound(Arr) + 1).Value = [COLOR=#ff0000]ArrayTo2D(Arr)[/COLOR]

là xong

Yeap ^^ !!

Tôi đã làm theo sự chỉ dẫn của bạn --> kết quả cũng đúng ý tôi rồi... hihi
Ngưỡng mộ bạn đã đâu hôm nay mới được bạn trực tiếp chỉ dẫn... quả thực là danh bất hư truyền!
Rất mong thời gian sau này được bạn giúp đỡ nhiều hơn nữa $-\\/.$

Xin cảm ơn bạn và diễn đàn nhiều nhiều!
Chúc mọi người một năm mới sức khỏe dồi dào, mọi việc tốt đẹp.
O.Thơ

ndu96081631 · 3/1/17

Nguyễn Hoàng Oanh Thơ đã viết:
Yeap ^^ !!

Tôi đã làm theo sự chỉ dẫn của bạn --> kết quả cũng đúng ý tôi rồi... hihi
Ngưỡng mộ bạn đã đâu hôm nay mới được bạn trực tiếp chỉ dẫn... quả thực là danh bất hư truyền!
Rất mong thời gian sau này được bạn giúp đỡ nhiều hơn nữa $-\\/.$

Xin cảm ơn bạn và diễn đàn nhiều nhiều!
Chúc mọi người một năm mới sức khỏe dồi dào, mọi việc tốt đẹp.
O.Thơ

Ôi! Giúp được người đẹp là niềm vinh hạnh của "kẻ hèn" này
Ẹc... Ẹc...

quocgiacan · 3/1/17

ndu96081631 đã viết:
Ôi! Giúp được người đẹp là niềm vinh hạnh của "kẻ hèn" này
Ẹc... Ẹc...

Tình Thầy, nghĩa trò nên cần cảnh báo!
Coi chừng là "bạn" đồng giới với doveandrose nha thầy }}}}}

ndu96081631 · 3/1/17

quocgiacan đã viết:
Tình Thầy, nghĩa trò nên cần cảnh báo!
Coi chừng là "bạn" đồng giới với doveandrose nha thầy

Kệ đi! Cứ thấy cái nick thuộc dạng NGƯỜI ĐẸP là mình hổng chịu nỗi, cứ RẦN RẦN vậy đó

VetMini · 4/1/17

quocgiacan đã viết:
Tình Thầy, nghĩa trò nên cần cảnh báo!
Coi chừng là "bạn" đồng giới với doveandrose nha thầy

Bộ đồng giới với cái tên Lặn rồi Trồi thì không đẹp được hả?

Hoàng Nhật Phương · 12/3/17

Lọc theo điều kiện?

Xin chào các bạn,

Nhờ các bạn giúp đỡ tôi trường hợp trong file đính kèm này với ạ.

befaint · 12/3/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,

Nhờ các bạn giúp đỡ tôi trường hợp trong file đính kèm này với ạ.

Hoặc 1:

Mã:

Sub FArray()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim tmp() As Variant, z As Long, r As Long, KQ() As Variant, j As Long, k As Long, kk As Long
Const dk As String = "0-TK"
With Sheet1
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    tmp = .Range("B5:BI" & z): z = UBound(tmp, 1): kk = UBound(tmp, 2)
End With
ReDim KQ(1 To z, 1 To kk)
For r = 1 To z
    If tmp(r, kk) = dk Then
        j = j + 1
        For k = 1 To kk
            KQ(j, k) = tmp(r, k)
        Next k
    End If
Next r
If j Then
    With Sheet2
    .Range("E6").Resize(65000, 60).ClearContents
    .Range("E6").Offset(0, 11).Resize(j, 1).NumberFormat = "dd/mm/yyyy"
    .Range("E6").Resize(j, kk) = KQ
    .Range("E6").Offset(j, 0) = "=SUM(E6:E" & j + 5 & ")"
    .Range("E6").Offset(j, 0).Resize(1, kk - 1).FillRight
    .Range("E6").Offset(j, 11).ClearContents
    End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hoặc 2:

Mã:

Sub AFilter()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim z As Long
Const dk As String = "0-TK"
With Sheet1
    .AutoFilterMode = False
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("BI4:BI" & z).AutoFilter Field:=1, Criteria1:=dk
    If .Range("B4:B" & z).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Sheet2.Range("E6").Resize(65000, 60).ClearContents
        .Range("B5:BI" & z).SpecialCells(xlCellTypeVisible).Copy
    Else
        Exit Sub
    End If
End With
Sheet2.Select
With Sheet2
    .Range("E6").PasteSpecial Paste:=xlPasteValues
    .Range("E6").Select
    z = .Range("E" & .Rows.Count).End(xlUp).Row + 1
    .Range("E6").Offset(0, 11).Resize(z - 6, 1).NumberFormat = "dd/mm/yyyy"
    .Range("E" & z) = "=SUM(E6:E" & z - 1 & ")"
    .Range("E" & z).Resize(1, 59).FillRight
    .Range("E" & z).Offset(0, 11).ClearContents
End With
sheet1.AutoFilterMode = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Kiều Mạnh · 12/3/17

befaint đã viết:

Hoặc 1:

Mã:

Sub FArray()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim tmp() As Variant, z As Long, r As Long, KQ() As Variant, j As Long, k As Long, kk As Long
Const dk As String = "0-TK"
With Sheet1
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    tmp = .Range("B5:BI" & z): [COLOR=#ff0000][B]z = UBound(tmp, 1): kk = UBound(tmp, 2)[/B][/COLOR]
End With
[COLOR=#ff0000][B]ReDim KQ(1 To z, 1 To kk)[/B][/COLOR]
For r = 1 To z
    If tmp(r, kk) = dk Then
        j = j + 1
        For k = 1 To kk
            KQ(j, k) = tmp(r, k)
        Next k
    End If
Next r
If j Then
    With Sheet2
    .Range("E6").Resize(65000, 60).ClearContents
    .Range("E6").Offset(0, 11).Resize(j, 1).NumberFormat = "dd/mm/yyyy"
    .Range("E6").Resize(j, [SIZE=3][COLOR=#ff0000][B]kk[/B][/COLOR][/SIZE]) = KQ
    .Range("E6").Offset(j, 0) = "=SUM(E6:E" & j + 5 & ")"
    .Range("E6").Offset(j, 0).Resize(1, kk - 1).FillRight
    .Range("E6").Offset(j, 11).ClearContents
    End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[/code]

Khai báo hay thế ...sáng tạo đó

befaint · 12/3/17

kieu manh đã viết:
Khai báo hay thế ...sáng tạo đó

.........................

Hoàng Nhật Phương · 13/3/17

befaint đã viết:

Hoặc 1:

Mã:

Sub FArray()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim tmp() As Variant, z As Long, r As Long, KQ() As Variant, j As Long, k As Long, kk As Long
Const dk As String = "0-TK"
With Sheet1
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    tmp = .Range("B5:BI" & z): z = UBound(tmp, 1): kk = UBound(tmp, 2)
End With
ReDim KQ(1 To z, 1 To kk)
For r = 1 To z
    If tmp(r, kk) = dk Then
        j = j + 1
        For k = 1 To kk
            KQ(j, k) = tmp(r, k)
        Next k
    End If
Next r
If j Then
    With Sheet2
    .Range("E6").Resize(65000, 60).ClearContents
    .Range("E6").Offset(0, 11).Resize(j, 1).NumberFormat = "dd/mm/yyyy"
    .Range("E6").Resize(j, kk) = KQ
    .Range("E6").Offset(j, 0) = "=SUM(E6:E" & j + 5 & ")"
    .Range("E6").Offset(j, 0).Resize(1, kk - 1).FillRight
    .Range("E6").Offset(j, 11).ClearContents
    End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hoặc 2:

Mã:

Sub AFilter()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim z As Long
Const dk As String = "0-TK"
With Sheet1
    .AutoFilterMode = False
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("BI4:BI" & z).AutoFilter Field:=1, Criteria1:=dk
    If .Range("B4:B" & z).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Sheet2.Range("E6").Resize(65000, 60).ClearContents
        .Range("B5:BI" & z).SpecialCells(xlCellTypeVisible).Copy
    Else
        Exit Sub
    End If
End With
Sheet2.Select
With Sheet2
    .Range("E6").PasteSpecial Paste:=xlPasteValues
    .Range("E6").Select
    z = .Range("E" & .Rows.Count).End(xlUp).Row + 1
    .Range("E6").Offset(0, 11).Resize(z - 6, 1).NumberFormat = "dd/mm/yyyy"
    .Range("E" & z) = "=SUM(E6:E" & z - 1 & ")"
    .Range("E" & z).Resize(1, 59).FillRight
    .Range("E" & z).Offset(0, 11).ClearContents
End With
sheet1.AutoFilterMode = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

xin cảm ơn befaint rất nhiều, cả 2 cách đều OK bạn ah.
Cách 2 tốc độ nhanh hơn cách 1 nhiều, hihi. :-=

VetMini · 13/3/17

@befaint:
Code số 1 của bạn có đến 7 biến dùng tên đơn giản mà không có giải thích, và không theo đường lối tên biến nào cả. Loại code này về sau rất khó sửa.
Theo lệ chung (*), nếu code đơn giản thì người ta có thể dùng i, j, k để làm số đếm. Nhưng nếu có mòi phức tạp một chút (code có đến 7 biến là phức tạp) thì ngừoi ta đặt tên cho dễ đọc. Ví dụ i thì gọi là cot, j gọi là dng, k là soDng, z và kk là cotMx và dngMx chẳng hạn.

Điểm thứ hai, điểm này quan trọng hơn, là bạn dùng một biến tên là tmp. Có lẽ do từ temporary (tạm). Loại tên này chỉ nên dùng cho biến có giá trị trong vòng 2 hay 3 dòng thôi. Sau 2-3 dòng, biến thay đổi thành tmp khác. Hầu hết các trường hợp, tên tmp được dùng để tạm chứa cái gì đó rồi chuyển đi lập tức. Điển hình là code hoán đổi trị:
tmp = a: a = b : b = tmp ' hoán đổi a và b

Điểm thứ 3, thường thì hằng (Const) ngừoi ta đặt tên dài một chút, và dùng tên hoa, ví dụ DIEUKIEN. Nhưng quan trọng hơn là nên đặt chúng ở đầu code, ngay sau dòng khai báo sub, function. Vì hằng thường là những thông số quyết định hoặc hở trợ cho cách làm việc của hàm. Khi đọc code, ngừoi ta thấy ngay là code này có những thông số gì, và khi cần thay đổi, khong phải tìm kiếm xa xôi.

(*) lệ chứ không phải luật.

befaint · 13/3/17

VetMini đã viết:
@befaint:
Code số 1 của bạn có đến 7 biến dùng tên đơn giản mà không có giải thích, và không theo đường lối tên biến nào cả. Loại code này về sau rất khó sửa.
Theo lệ chung (*), nếu code đơn giản thì người ta có thể dùng i, j, k để làm số đếm. Nhưng nếu có mòi phức tạp một chút (code có đến 7 biến là phức tạp) thì ngừoi ta đặt tên cho dễ đọc. Ví dụ i thì gọi là cot, j gọi là dng, k là soDng, z và kk là cotMx và dngMx chẳng hạn.

Điểm thứ hai, điểm này quan trọng hơn, là bạn dùng một biến tên là tmp. Có lẽ do từ temporary (tạm). Loại tên này chỉ nên dùng cho biến có giá trị trong vòng 2 hay 3 dòng thôi. Sau 2-3 dòng, biến thay đổi thành tmp khác. Hầu hết các trường hợp, tên tmp được dùng để tạm chứa cái gì đó rồi chuyển đi lập tức. Điển hình là code hoán đổi trị:
tmp = a: a = b : b = tmp ' hoán đổi a và b

Điểm thứ 3, thường thì hằng (Const) ngừoi ta đặt tên dài một chút, và dùng tên hoa, ví dụ DIEUKIEN. Nhưng quan trọng hơn là nên đặt chúng ở đầu code, ngay sau dòng khai báo sub, function. Vì hằng thường là những thông số quyết định hoặc hở trợ cho cách làm việc của hàm. Khi đọc code, ngừoi ta thấy ngay là code này có những thông số gì, và khi cần thay đổi, khong phải tìm kiếm xa xôi.

(*) lệ chứ không phải luật.

Cảm ơn anh. Em sẽ điều chỉnh dần.

Chúc anh ngày vui!

Hoàng Nhật Phương · 13/3/17

VetMini đã viết:
@befaint:
Code số 1 của bạn có đến 7 biến dùng tên đơn giản mà không có giải thích, và không theo đường lối tên biến nào cả. Loại code này về sau rất khó sửa.
Theo lệ chung (*), nếu code đơn giản thì người ta có thể dùng i, j, k để làm số đếm. Nhưng nếu có mòi phức tạp một chút (code có đến 7 biến là phức tạp) thì ngừoi ta đặt tên cho dễ đọc. Ví dụ i thì gọi là cot, j gọi là dng, k là soDng, z và kk là cotMx và dngMx chẳng hạn.

Điểm thứ hai, điểm này quan trọng hơn, là bạn dùng một biến tên là tmp. Có lẽ do từ temporary (tạm). Loại tên này chỉ nên dùng cho biến có giá trị trong vòng 2 hay 3 dòng thôi. Sau 2-3 dòng, biến thay đổi thành tmp khác. Hầu hết các trường hợp, tên tmp được dùng để tạm chứa cái gì đó rồi chuyển đi lập tức. Điển hình là code hoán đổi trị:
tmp = a: a = b : b = tmp ' hoán đổi a và b

Điểm thứ 3, thường thì hằng (Const) ngừoi ta đặt tên dài một chút, và dùng tên hoa, ví dụ DIEUKIEN. Nhưng quan trọng hơn là nên đặt chúng ở đầu code, ngay sau dòng khai báo sub, function. Vì hằng thường là những thông số quyết định hoặc hở trợ cho cách làm việc của hàm. Khi đọc code, ngừoi ta thấy ngay là code này có những thông số gì, và khi cần thay đổi, khong phải tìm kiếm xa xôi.

(*) lệ chứ không phải luật.

Hi, cảm ơn VetMini đã tham gia góp ý ạ
Đúng như bạn đã nhận xét ạ,code với tôi không có coment ở mỗi dòng đúng là rất khó khăn cho những người không hiểu biết về code như tôi ạ.
Cứ mỗi lần sửa sửa hay thêm bớt cái gì,tôi không biết phải tự sửa code thế nào nên lại đưa lên đây để hỏi. (T_T)

befaint đã viết:
Cảm ơn anh. Em sẽ điều chỉnh dần.

Chúc anh ngày vui!

befaint ơi ,lúc nào bạn điều chỉnh gì thì điều chỉnh trong chủ đề này bạn nhé.
Hi cảm ơn bạn nhiều.

Hoàng Nhật Phương · 16/3/17

Xin chào các bạn,
Tôi đang vướng mắc về vấn lọc dữ liệu theo điều kiện (cụ thể nêu trong sheet3 của file kèm), tôi đã loay hoay suốt hàng giờ đồng mà không biết code như thế nào.
Nên up lên đây nhờ các bạn giúp đỡ các bạn giúp đỡ cho ạ:
Hic, do hết dung lượng đưa file trực tiếp lên diễn đàn,vì vậy Oanh Thơ gửi file vào đây ạ: (T_T)
https://secufiles.com/4Lm8/loc_(1).xlsb

Phiền các bạn xem và giúp đỡ cho ạ.

eke_rula · 16/3/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Tôi đang vướng mắc về vấn lọc dữ liệu theo điều kiện (cụ thể nêu trong sheet3 của file kèm), tôi đã loay hoay suốt hàng giờ đồng mà không biết code như thế nào.
Nên up lên đây nhờ các bạn giúp đỡ các bạn giúp đỡ cho ạ:
Hic, do hết dung lượng đưa file trực tiếp lên diễn đàn,vì vậy Oanh Thơ gửi file vào đây ạ: (T_T)
https://secufiles.com/4Lm8/loc_(1).xlsb

Phiền các bạn xem và giúp đỡ cho ạ.

Dữ liệu của bạn nhiều quá, bạn có thể dùng CT mảng này tại G6:

PHP:

G6=INDEX(Sheet1!D:D,SMALL(IF(Sheet1!$M$5:$M$66444>=Sheet3!$H$2,IF(Sheet1!$M$5:$M$66444<=Sheet3!$J$2,ROW(Sheet1!$D$5:$D$66444))),ROW(A1)))

Fill sang phải, rồi fill xuống dưới rồi đợi khoảng ... 2 phút!!!
Bài này nhờ các anh chị khác viết VBA cho bạn sẽ hay hơn, chạy bằng CT nặng!!!

Hoàng Nhật Phương · 16/3/17

eke_rula đã viết:
Dữ liệu của bạn nhiều quá, bạn có thể dùng CT mảng này tại G6:

PHP:

G6=INDEX(Sheet1!D:D,SMALL(IF(Sheet1!$M$5:$M$66444>=Sheet3!$H$2,IF(Sheet1!$M$5:$M$66444<=Sheet3!$J$2,ROW(Sheet1!$D$5:$D$66444))),ROW(A1)))

Fill sang phải, rồi fill xuống dưới rồi đợi khoảng ... 2 phút!!!
Bài này nhờ các anh chị khác viết VBA cho bạn sẽ hay hơn, chạy bằng CT nặng!!!

Hi, cảm ơn eke_rula rất nhiều,
Bạn nhiệt tình thật đó đêm đã khuya mà bạn vẫn còn vào diễn đàn để giúp đỡ mọi người ^^
Với cách sử dụng bằng công thức của bạn nêu trên tôi sẽ lưu lại để vẫn dụng trong trường hợp tập tin ít dữ liệu.
Còn với bài này của tôi dữ liệu thực gần 150k dòng rồi bạn ạ,bởi vì dữ liệu update liên tục theo năm tháng, nên muốn có giải pháp bằng vba bạn ạ hic (_ _)

Hoang2013 · 16/3/17

Tôi vướng về lọc dữ liệu theo điều kiện (cụ thể nêu trong sheet3 của file kèm), tôi đã loay hoay suốt hàng giờ đồng mà không biết code như thế nào. . . .

PHP:

Option Explicit
Sub LocKhoangTG()
 Dim Arr()
 Dim Rws As Long, J As Long, W As Long, fDat As Date, lDat As Date, Tmr As Double
 
 Tmr = Timer()
  With Sheet1.[d5]  
    Rws = .CurrentRegion.Rows.Count
    Arr() = .Resize(Rws, 10).Value
  End With    
 ReDim dArr(1 To Rws, 1 To 2) As String
 With Sheet3
    fDat = .[h2].Value:             lDat = .[j2].Value
    For J = 1 To UBound(Arr())
        If Arr(J, 10) >= fDat And Arr(J, 10) <= lDat Then
            W = W + 1:              dArr(W, 1) = Arr(J, 1)
            dArr(W, 2) = Arr(J, 2)
        End If
    Next J
'    If W Then  '
        .[g6].Resize(J, 2).Value = dArr()
        .[j4] = Timer() - Tmr
'    End If     '
 End With 
End Sub

$:=\+$

Hoàng Nhật Phương · 16/3/17

Hoang2013 đã viết:

Mã:

Option Explicit
Sub LocKhoangTG()
 Dim Arr()
 Dim Rws As Long, J As Long, W As Long, fDat As Date, lDat As Date, Tmr As Double
 
 Tmr = Timer()
  With Sheet1.[d5]  
    Rws = .CurrentRegion.Rows.Count
    Arr() = .Resize(Rws, 10).Value
  End With    
 ReDim dArr(1 To Rws, 1 To 2) As String
 With Sheet3
    fDat = .[h2].Value:             lDat = .[j2].Value
    For J = 1 To UBound(Arr())
        If Arr(J, 10) >= fDat And Arr(J, 10) <= lDat Then
            W = W + 1:              dArr(W, 1) = Arr(J, 1)
            dArr(W, 2) = Arr(J, 2)
        End If
    Next J
'    If W Then  '
        .[g6].Resize(J, 2).Value = dArr()
        .[j4] = Timer() - Tmr
'    End If     '
[COLOR=#ff0000][B].[G5:H100000].RemoveDuplicates Columns:=1, header:=xlYes[/B][/COLOR]
 End With 
End Sub

$:=\+$

Cảm bạn Hoang2013 đã hỗ trợ ạ.
Về tiêu đề tôi sẽ lưu ý.
về code tôi đã thử kết quả rất OK và code chạy rất nhanh, cảm ơn bạn rất nhiều.
----
Xin hỏi bạn thêm 1 vấn đề nữa liên quan đến bài toán lọc duy nhất ạ:

Do file thực tại cột D của sheet1 là danh sách các mã hàng được cập nhật theo các ngày trong tháng nên sẽ có rất nhiều mã hàng trùng nhau.
Vì vậy code trên của bạn tôi có bổ sung thêm dòng màu đỏ để xóa các dữ liệu trùng nhau tại cột G6:H theo cột G.
Nhưng với dòng code này sẽ xóa đi hết các định dạng của các cell.

Rất mong bạn giúp đỡ cho tôi thêm 1 cách khác để thay thế cho dòng màu đỏ trên.

Hoang2013 · 16/3/17

Vì code trên của bạn tôi có bổ sung thêm dòng màu đỏ để xóa các dữ liệu trùng nhau tại cột G6:H theo cột G.
Nhưng với dòng code này sẽ xóa đi hết các định dạng của các cell.

Rất mong bạn giúp đỡ cho tôi thêm 1 cách khác để thay thế cho dòng màu đỏ trên.

Không phải dòng Code đó xóa định dạng của bạn đâu, đừng nghĩ oan cho nó.

Macro làm cái công việc nạp dữ liệu từ mảng lên 2 cột trang tính thì định dạng thế nào trước đó nó vẫn bảo lưu mà.

(Hay mình chưa rõ í của bạn, không biết nữa?)

Hoàng Nhật Phương · 16/3/17

Hoang2013 đã viết:
Không phải dòng Code đó xóa định dạng của bạn đâu, đừng nghĩ oan cho nó.

Macro làm cái công việc nạp dữ liệu từ mảng lên 2 cột trang tính thì định dạng thế nào trước đó nó vẫn bảo lưu mà.

(Hay mình chưa rõ í của bạn, không biết nữa?)

Xin chào Hoang2013

Ý tôi là cái dòng này, mà tôi thêm vào:

Mã:

.[G5:H100000].RemoveDuplicates Columns:=1, header:=xlYes

nó sẽ xóa đi các định dạng bạn ah.

Mong muốn bạn hướng dẫn một giải pháp khác thay cho sử dụng RemoveDuplicates ạ.

befaint · 16/3/17

Nguyễn Hoàng Oanh Thơ đã viết:
Do file thực tại cột D của sheet1 là danh sách các mã hàng được cập nhật theo các ngày trong tháng nên sẽ có rất nhiều mã hàng trùng nhau.

Mã:

Sub LocMot()
Dim DL As Variant, z As Long, r As Long, KQ() As Variant, j As Long
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DL = .Range("D5:M" & z).Value2: z = UBound(DL, 1)
    ReDim KQ(1 To z, 1 To 2)
    For r = 1 To z
        D = DL(r, 10)
        If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                tmp = DL(r, 1)
                If tmp <> Empty And Not Dic.Exists(tmp) Then
                    Dic.Add tmp, ""
                    j = j + 1
                    KQ(j, 1) = tmp: KQ(j, 2) = DL(r, 2)
                End If
            End If
        End If
    Next r
End With
If j Then
    Sheet3.Range("G6").Resize(100000, 2).ClearContents
    Sheet3.Range("G6").Resize(j, 2) = KQ
End If
End Sub

p/s: Có thể upload file lên trang khác được không? Link bài #20 toàn quảng cáo...

Hoàng Nhật Phương · 16/3/17

befaint đã viết:

Mã:

Sub LocMot()
Dim DL As Variant, z As Long, r As Long, KQ() As Variant, j As Long
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DL = .Range("D5:M" & z).Value2: z = UBound(DL, 1)
    ReDim KQ(1 To z, 1 To 2)
    For r = 1 To z
        D = DL(r, 10)
        If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                tmp = DL(r, 1)
                If tmp <> Empty And Not Dic.Exists(tmp) Then
                    Dic.Add tmp, ""
                    j = j + 1
                    KQ(j, 1) = tmp: KQ(j, 2) = DL(r, 2)
                End If
            End If
        End If
    Next r
End With
If j Then
    Sheet3.Range("G6").Resize(100000, 2).ClearContents
    Sheet3.Range("G6").Resize(j, 2) = KQ
End If
End Sub

p/s: Có thể upload file lên trang khác được không? Link bài #20 toàn quảng cáo...

Cảm ơn befaint rất nhiều, kết quả ưng quá rồi bạn ạ.
Vâng được ạ,Oanh Thơ sẽ lưu ý!

Nguyễn Duy Tuân · 16/3/17

Công thức tạo danh sách duy nhất với hàm BS_Unique, sắp xếp, tạo NAME trong Excel

LỌC DANH SÁCH DUY NHẤT VỚI HÀM BS_UNIQUE() - DÀNH CHO NHỮNG BẠN KHÔNG QUAN TÂM TỚI LẬP TRÌNH VBA - CHỈ DÙNG HÀM!
Từ một vùng dữ liệu, lấy danh sách duy nhất, danh sách được sắp xếp tăng/giảm dần là một việc rất khó khi làm công thức Excel. Với Add-in A-Tools bạn chỉ cần một hàm BS_UNIQUE. Danh sách duy nhất cho phép co giãn dòng, đặt NAME bao dữ liệu tự động để tương tác với công cụ Excel khác như Validation - List,...

[video=youtube;eCzEN0ckN0w]https://www.youtube.com/watch?v=eCzEN0ckN0w[/video]

Lọc duy nhất ? (1 người xem)

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

Thành viên gắn bó

File đính kèm

|||||||||||||

File đính kèm

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

Thành viên lười biếng

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

-⍟-

Huyền thoại GPE

Đang đi tìm hòn đá

Thành viên gắn bó

File đính kèm

|||||||||||||

I don't program, I beat code into submission!!!

|||||||||||||

Thành viên gắn bó

Đang đi tìm hòn đá

|||||||||||||

Thành viên gắn bó

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

Nghị Hách

Thời gian đếm ngược.