Sửa dùm code lọc dữ liệu (1 người xem)

chapi.you · 27/3/11

Tôi có code này, làm mãi không được. Tôi đưa lên đây để nhờ các AC xem và sửa dùm cho đúng!

concogia · 27/3/11

chapi.you đã viết:
Tôi có code này, làm mãi không được. Tôi đưa lên đây để nhờ các AC xem và sửa dùm cho đúng!

Thủ như thế này xem

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$1" Then
    Application.ScreenUpdating = False
    With S1.Range(S1.[A1], S1.[a10000].End(3)).Resize(, 2)
        .AutoFilter 1, S2.[E1] & "*"
        .Offset(1, 0).Resize(, 2).SpecialCells(12).Copy S2.[A4]
        .AutoFilter
    End With
    End If
End Sub

Thân

ndu96081631 · 27/3/11

chapi.you đã viết:
Tôi có code này, làm mãi không được. Tôi đưa lên đây để nhờ các AC xem và sửa dùm cho đúng!

Sai cả 1 "rổ" luôn
Cái này:

Mã:

With S1.Range(S1.[A1], [COLOR=red][B]S1.[10000][/B][/COLOR].End(3)).Resize(, 2)

Cái màu đỏ là cái gì? Có phải muốn nói là S1.[A10000] hay không?
Còn cái này:

Mã:

.AutoFilter 1, Left(S1.[A2:A10000], 2) = S2.[E1]

Cái thằng VBA mà nó hiểu bạn nói gì chết liền
Nhưng tôi hơi... hiểu hiểu ---> Chắc là vầy:

Mã:

.AutoFilter 1, Target.Value & "*"

Mấy vụ này nếu không biết thì có thể Record macro sao bạn không chịu thử nhỉ?
Làm lại:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo ExitSub
  If Target.Address = "$E$1" Then
    Range("A3:B10000").Clear
    With S1.Range(S1.[A1], S1.[A10000].End(xlUp)).Resize(, 2)
      .AutoFilter 1, Target.Value & "*"
      .SpecialCells(12).Copy S2.[A3]
      .AutoFilter
    End With
  End If
ExitSub:
End Sub

ndu96081631 · 27/3/11

Chỉ bạn dùng Advanced Filter cho bài này, code sẽ gọn hơn
Đầu tiên bố trí lại dữ liệu, chọn Validaiton xuống cell E2, còn cell E1 gõ chữ "Mã hàng"

Code rút gọn thành vầy:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$2" Then
    Range("A3:B10000").Clear
    S1.Range("A1").CurrentRegion.AdvancedFilter 2, [E1:E2], [A3]
  End If
End Sub

-----------------------------
Nói thêm: Với dữ liệu cở vài chục ngàn dòng, nếu bạn dùng AutoFilter để lọc, sau đó dùng SpecialCells thì chắc chắn có lúc code bị lỗi (SpecialCells bị quá tải)... Dùng Advanced Filter lại không gặp hiện tượng này vì nó copy trực tiếp luôn

nmh_phocu · 31/3/12

ndu96081631 đã viết:
Chỉ bạn dùng Advanced Filter cho bài này, code sẽ gọn hơn
Đầu tiên bố trí lại dữ liệu, chọn Validaiton xuống cell E2, còn cell E1 gõ chữ "Mã hàng"

View attachment 60451

Code rút gọn thành vầy:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$E$2" Then Range("A3:B10000").Clear S1.Range("A1").CurrentRegion.AdvancedFilter 2, [E1:E2], [A3] End If End Sub

-----------------------------
Nói thêm: Với dữ liệu cở vài chục ngàn dòng, nếu bạn dùng AutoFilter để lọc, sau đó dùng SpecialCells thì chắc chắn có lúc code bị lỗi (SpecialCells bị quá tải)... Dùng Advanced Filter lại không gặp hiện tượng này vì nó copy trực tiếp luôn

Rất tuyệt vời em cảm ơn bác, bác có thể nâng cấp tiếp được không, em thấy có 2 vấn đề:

Ở code lọc này chỉ lọc các chữ cái tính từ trái sang phải, nhưng có thể lọc cho dù chữ cái đó ở bất kỳ vị trí nào trong mã không anh. ví dụ có 2 mã Hung, Hang cùng có chữ n khi em đánh chữ n thì nó lấy cả 2 vì cùng có chữ n ở vị trí bất kỳ. Tiếp đến nếu mã mà là số thì cái này không chạy
Chân thành cảm ơn anh

ndu96081631 · 31/3/12

nmh_phocu đã viết:
Rất tuyệt vời em cảm ơn bác, bác có thể nâng cấp tiếp được không, em thấy có 2 vấn đề:

Ở code lọc này chỉ lọc các chữ cái tính từ trái sang phải, nhưng có thể lọc cho dù chữ cái đó ở bất kỳ vị trí nào trong mã không anh. ví dụ có 2 mã Hung, Hang cùng có chữ n khi em đánh chữ n thì nó lấy cả 2 vì cùng có chữ n ở vị trí bất kỳ. Tiếp đến nếu mã mà là số thì cái này không chạy
Chân thành cảm ơn anh

Đưa dữ liệu của bạn lên đi cho dễ hình dung... Nhưng tôi xin nói sơ qua về điều kiện trong Advanced Filter:
- Lọc điều kiện chuổi: Có thể dùng ký tự đại diện như * hoặc ?
- Lọc điều kiện là số: Có thể dùng các toán tự so sánh như >, <, >=, <= và =

Xuân hiếu · 25/2/14

Mọi người giúp viết dùm code lọc dữ liệu này với xin cảm ơn
Cột TT tự động tính.

xuan.nguyen82 · 25/2/14

Xuân hiếu đã viết:
Mọi người giúp viết dùm code lọc dữ liệu này với xin cảm ơn
Cột TT tự động tính.

Bạn xem file này xem đúng ý bạn không nhé.

Xuân hiếu · 26/2/14

Code của bạn làm gần đúng ý mình, nếu trường hợp như file mình bạn xem cái đường viền ở giữa cột BC, cột KL, MN mình muốn không tô viền thì làm bằng cách nào

xuan.nguyen82 đã viết:
Bạn xem file này xem đúng ý bạn không nhé.

Ngoai Thanh · 26/2/14

Xuân hiếu đã viết:
Code của bạn làm gần đúng ý mình, nếu trường hợp như file mình bạn xem cái đường viền ở giữa cột BC, cột KL, MN mình muốn không tô viền thì làm bằng cách nào

Bạn thêm vào cuối code
Range("B7:C1000,K7:L1000,M7:N1000").Select
Selection.Borders(xlInsideVertical).LineStyle = xlNone
chắc là được .

nmhung49 · 26/2/14

Sửa lại code trên chút xíu sẽ được

Mã:

Public Sub LOC_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, DK As String
With Sheets("DATA")
    sArr = .Range(.[B7], .[B65536].End(xlUp)).Resize(, 61).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 15)
With Sheets("LOC")
    tArr = .[A5:O5].Value2
    DK = .[J1].Value2
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 50) = DK Then
            K = K + 1: dArr(K, 1) = K
            For J = 2 To 15
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        End If
    Next I
    With .[A7].Resize(1000, 15)
    .ClearContents
    .Borders.LineStyle = xlNone
    End With
    If K Then
        With .[A7].Resize(K, 15)
            .Value = dArr
            .Borders.LineStyle = xlContinuous
        End With
        With Union(.[B7].Resize(K, 2), .[K7].Resize(K, 2))
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        With .[M7].Resize(K, 2)
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    End If
End With
Application.ScreenUpdating = True
End Sub

Xuân hiếu · 28/2/14

nmhung49 đã viết:

Sửa lại code trên chút xíu sẽ được

Mã:

Public Sub LOC_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, DK As String
With Sheets("DATA")
    sArr = .Range(.[B7], .[B65536].End(xlUp)).Resize(, 61).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 15)
With Sheets("LOC")
    tArr = .[A5:O5].Value2
    DK = .[J1].Value2
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 50) = DK Then
            K = K + 1: dArr(K, 1) = K
            For J = 2 To 15
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        End If
    Next I
    With .[A7].Resize(1000, 15)
    .ClearContents
    .Borders.LineStyle = xlNone
    End With
    If K Then
        With .[A7].Resize(K, 15)
            .Value = dArr
            .Borders.LineStyle = xlContinuous
        End With
        With Union(.[B7].Resize(K, 2), .[K7].Resize(K, 2))
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        With .[M7].Resize(K, 2)
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    End If
End With
Application.ScreenUpdating = True
End Sub

CODE này chưa đúng lắm bạn xem giúp khung viền giống như trong file mình gửi kèm cảm ơn

Ba Tê · 28/2/14

Xuân hiếu đã viết:
CODE này chưa đúng lắm bạn xem giúp khung viền giống như trong file mình gửi kèm cảm ơn

Vậy thì lấy code này:
Thêm của xuan.nguyen82 một chút.

PHP:

Public Sub LOC_GPE()
Application.ScreenUpdating = False
Dim sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, DK As String
With Sheets("DATA")
    sArr = .Range(.[B7], .[B65536].End(xlUp)).Resize(, 61).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 15)
With Sheets("LOC")
    tArr = .[A5:O5].Value2
    DK = .[J1].Value2
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 50) = DK Then
            K = K + 1: dArr(K, 1) = K
            For J = 2 To 15
                dArr(K, J) = sArr(I, tArr(1, J))
            Next J
        End If
    Next I
    .[A7].Resize(1000, 15).ClearContents
    .[A7].Resize(1000, 15).Borders.LineStyle = xlNone
    If K Then
        With .[A7].Resize(K, 15)
        .Value = dArr
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        .[B7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
        .[K7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
        .[M7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
    End If
End With
Application.ScreenUpdating = True
End Sub

Sửa dùm code lọc dữ liệu (1 người xem)

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

chapi.you

Thành viên mới

File đính kèm

concogia

Gội rồi mới Cạo

ndu96081631

Huyền thoại GPE

ndu96081631

Huyền thoại GPE

File đính kèm

nmh_phocu

Thành viên mới

ndu96081631

Huyền thoại GPE

Xuân hiếu

Thành viên thường trực

File đính kèm

xuan.nguyen82

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

File đính kèm

Xuân hiếu

Thành viên thường trực

Ngoai Thanh

Cánh Diều xanh

nmhung49

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

Xuân hiếu

Thành viên thường trực

File đính kèm

Ba Tê

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

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian