Lộc dữ liệu theo điều kiện (1 người xem)

HocVBAExcel · 9/12/15

Điều kiện của mình lọc như sau
Nếu điều kiện ở ô J3 bằng với mã dòng F thì lọc ngược lại thì xuất hiện thông báo "MÃ KHÔNG TỒN TẠI"
Do IT chặn bằng phần mềm nên không chèn file được.
Cyberoam Access denied

The URL you are trying to access has been blocked because "Upload Access Denied"

URL: www.giaiphapexcel.com/forum/newattachment.php?do=manageattach
CATEGORY: InformationTechnology

Chèn tạm link sau
http://www.fshare.vn/file/O928NENV6XYO

Ba Tê · 9/12/15

HocVBAExcel đã viết:
Điều kiện của mình lọc như sau
Nếu điều kiện ở ô J3 bằng với mã dòng F thì lọc ngược lại thì xuất hiện thông báo "MÃ KHÔNG TỒN TẠI"
Do IT chặn bằng phần mềm nên không chèn file được.
Cyberoam Access denied

The URL you are trying to access has been blocked because "Upload Access Denied"

URL: www.giaiphapexcel.com/forum/newattachment.php?do=manageattach
CATEGORY: InformationTechnology

Chèn tạm link sau
http://www.fshare.vn/file/O928NENV6XYO

Sửa theo code đã có của bạn trong file:

PHP:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, Col As Long
Arr = Range("C4", [C1000].End(xlUp)).Resize(, 6).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 7)
Range("K7:P1000").ClearContents
For J = 1 To 6
    If Arr(1, J) = [J3].Value Then Col = J
Next J
    If Col = 0 Then
        MsgBox "Khong co ma nay."
        Exit Sub
    End If
      For I = 4 To UBound(Arr, 1)
            If Arr(I, Col) <> Empty Then
              K = K + 1
             dArr(K, 1) = Arr(1, Col)
             dArr(K, 2) = Arr(2, Col)
             dArr(K, 3) = Arr(I, 3)
             dArr(K, 4) = Arr(I, 1)
             dArr(K, 5) = Arr(I, 2)
             dArr(K, 6) = Arr(I, Col)
            End If
      Next
Range("K7").Resize(K, 6) = dArr
End Sub

HocVBAExcel · 9/12/15

Ba Tê đã viết:

Sửa theo code đã có của bạn trong file:

PHP:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, Col As Long
Arr = Range("C4", [C1000].End(xlUp)).Resize(, 6).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 7)
Range("K7:P1000").ClearContents
For J = 1 To 6
    If Arr(1, J) = [J3].Value Then Col = J
Next J
    If Col = 0 Then
        MsgBox "Khong co ma nay."
        Exit Sub
    End If
      For I = 4 To UBound(Arr, 1)
            If Arr(I, Col) <> Empty Then
              K = K + 1
             dArr(K, 1) = Arr(1, Col)
             dArr(K, 2) = Arr(2, Col)
             dArr(K, 3) = Arr(I, 3)
             dArr(K, 4) = Arr(I, 1)
             dArr(K, 5) = Arr(I, 2)
             dArr(K, 6) = Arr(I, Col)
            End If
      Next
Range("K7").Resize(K, 6) = dArr
End Sub

Đúng rồi anh ,Cám ớn anh nhiều.

Ba Tê · 9/12/15

HocVBAExcel đã viết:
Đúng rồi anh ,Cám ớn anh nhiều.

Code trên vẫn chưa bẫy lỗi K=0.
Còn phân biệt chữ Hoa, Thường của J3 so với dòng mã.

HocVBAExcel · 9/12/15

hpkhuong đã viết:

Mã:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long
Arr = Range([C4], [C65000].End(3)).Resize(, 6).Value
ReDim dArr(1 To UBound(Arr), 1 To 6)
For I = 4 To UBound(Arr)
    For J = 4 To 6
        If Arr(1, J) = [J3].Value And Arr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = Arr(1, J)
            dArr(K, 2) = Arr(2, J)
            dArr(K, 3) = Arr(I, 3)
            dArr(K, 4) = Arr(I, 1)
            dArr(K, 5) = Arr(I, 2)
            dArr(K, 6) = Arr(I, J)
        End If
    Next J
Next I
Range("K7:P1000").ClearContents
If K Then
    Range("K7").Resize(K, 6).Value = dArr()
Else
    MsgBox "Ma Khong Ton Tai"
End If
End Sub

Code này nếu J3 rỗng thì thực hiện được
Cám ơn anh nhiều

HocVBAExcel · 9/12/15

Ba Tê đã viết:
Code trên vẫn chưa bẫy lỗi K=0.
Còn phân biệt chữ Hoa, Thường của J3 so với dòng mã.

Đúng rồi Anh nếu ô J3 rỗng thì bổ sung thêm điều kiện như thế nào anh.

Ba Tê · 9/12/15

HocVBAExcel đã viết:
Đúng rồi Anh nếu ô J3 rỗng thì bổ sung thêm điều kiện như thế nào anh.

Thêm bẫy lỗi J3= rỗng, K=0, Phân biệt chữ Hoa Thường.

PHP:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, Col As Long
Arr = Range("C4", Range("C1000").End(xlUp)).Resize(, 6).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 7)
Range("K7:P1000").ClearContents
If Range("J3") = Empty Then Exit Sub
For J = 1 To 6
    If UCase(Arr(1, J)) = UCase(Range("J3")) Then Col = J
Next J
    If Col = 0 Then
        MsgBox "Khong co ma nay."
        Exit Sub
    End If
      For I = 4 To UBound(Arr, 1)
            If Arr(I, Col) <> Empty Then
              K = K + 1
             dArr(K, 1) = Arr(1, Col)
             dArr(K, 2) = Arr(2, Col)
             dArr(K, 3) = Arr(I, 3)
             dArr(K, 4) = Arr(I, 1)
             dArr(K, 5) = Arr(I, 2)
             dArr(K, 6) = Arr(I, Col)
            End If
      Next
If K Then Range("K7").Resize(K, 6) = dArr
End Sub

Ba Tê · 9/12/15

hpkhuong đã viết:

Hình như bạn chưa biết Click cám ơn mọi người!

Mã:

Private Sub CommandButton1_Click()
Dim Arr(), dArr(), I As Long, J As Long, K As Long
Arr = Range([C4], [C65000].End(3)).Resize(, 6).Value
ReDim dArr(1 To UBound(Arr), 1 To 6)
For I = 4 To UBound(Arr)
    For J = 4 To 6
        If UCase(Arr(1, J)) = UCase([J3].Value) And Arr(I, J) <> Empty Then
            K = K + 1
            dArr(K, 1) = Arr(1, J)
            dArr(K, 2) = Arr(2, J)
            dArr(K, 3) = Arr(I, 3)
            dArr(K, 4) = Arr(I, 1)
            dArr(K, 5) = Arr(I, 2)
            dArr(K, 6) = Arr(I, J)
        End If
    Next J
Next I
Range("K7:P1000").ClearContents
If K Then
    Range("K7").Resize(K, 6).Value = dArr()
Else
    MsgBox "Ma Khong Ton Tai"
End If
End Sub

Không bàn về kết quả, chỉ xét hoạt động:
- J3 rỗng hay không, code vẫn phải làm hết việc sau 2 vòng lặp I, J.
- Vòng lặp J nằm trong vòng lặp I, Nếu I từ 1 - 1000 thì phải chạy vòng J 1000 lần.
Chỉ là nhìn code, không có ý gì cả nhé.

giangleloi · 9/12/15

Ba Tê đã viết:
Không bàn về kết quả, chỉ xét hoạt động:
- J3 rỗng hay không, code vẫn phải làm hết việc sau 2 vòng lặp I, J.
- Vòng lặp J nằm trong vòng lặp I, Nếu I từ 1 - 1000 thì phải chạy vòng J 1000 lần.
Chỉ là nhìn code, không có ý gì cả nhé.

2 trường hợp exit sub của "bác" nếu rơi vào code của hpkhuong đương nhiên code của hpkhuong sẽ hoạt động không tốt (Chưa kể đến cái "And" nữa). Những người không phải là dân lập trình chuyên nghiệp (trong đó có cả người hỏi lẫn người giúp), ra được kết quả là họ mừng hết lớn rồi. Còn đã cùng xài mảng thì dữ liệu lớn mắt thường mới thấy rõ được tốc độ khi code hoạt động.

HocVBAExcel · 9/12/15

Ba Tê đã viết:
Không bàn về kết quả, chỉ xét hoạt động:
- J3 rỗng hay không, code vẫn phải làm hết việc sau 2 vòng lặp I, J.
- Vòng lặp J nằm trong vòng lặp I, Nếu I từ 1 - 1000 thì phải chạy vòng J 1000 lần.
Chỉ là nhìn code, không có ý gì cả nhé.

Vậy Anh viết cho em đoạn code khác xem tốc độ nhanh hơn không
Dữ liệu thật của em 5000 dòng và 1500 cột.

Ba Tê · 9/12/15

Gởi: người viết bài #11 và #12:
Tôi đã nói không bàn về kết quả (cũng không nói về tốc độ), tôi có ghi là "Chỉ là nhìn code, không có ý gì cả nhé.".
Nghiã là tôi không phân tích chậm, nhanh, khoái hay không khoái, bàn hay không bàn về cái này (Còn việc nhanh/hay chậm ta khoan bàn), v.v... Tôi đã sợ "lắm lắm" chuyên tranh luận rồi.
Gởi: người viết Bài #13: "Vậy Anh viết cho em đoạn code khác xem tốc độ nhanh hơn không", câu này giống như thách đố quá, bạn đừng suy nghĩ kiểu đó, tôi không tranh hơn thua, code thì tôi đã viết rồi, "thất nghiệp" thì tham gia thôi, biết đến đâu tham gia đến đó, "bí" thì chạy. Tất cả đều là trao đổi học tập lẫn nhau.

HocVBAExcel · 9/12/15

Ba Tê đã viết:
Gởi: người viết bài #11 và #12:
Tôi đã nói không bàn về kết quả (cũng không nói về tốc độ), tôi có ghi là "Chỉ là nhìn code, không có ý gì cả nhé.".
Nghiã là tôi không phân tích chậm, nhanh, khoái hay không khoái, bàn hay không bàn về cái này (Còn việc nhanh/hay chậm ta khoan bàn), v.v... Tôi đã sợ "lắm lắm" chuyên tranh luận rồi.
Gởi: người viết Bài #13: "Vậy Anh viết cho em đoạn code khác xem tốc độ nhanh hơn không", câu này giống như thách đố quá, bạn đừng suy nghĩ kiểu đó, tôi không tranh hơn thua, code thì tôi đã viết rồi, "thất nghiệp" thì tham gia thôi, biết đến đâu tham gia đến đó, "bí" thì chạy. Tất cả đều là trao đổi học tập lẫn nhau.

Ý em không thách đố gì anh đâu ,ý em muốn học hỏi thêm có đoạn code nào hay không, Nếu em có lời gì không hay thì anh bỏ qua cho.

Lộc dữ liệu theo điều kiện (1 người xem)

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

HocVBAExcel

Thành viên mới

Ba Tê

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

HocVBAExcel

Thành viên mới

Ba Tê

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

HocVBAExcel

Thành viên mới

HocVBAExcel

Thành viên mới

Ba Tê

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

Ba Tê

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

giangleloi

Thành viên gắn bó

HocVBAExcel

Thành viên mới

Ba Tê

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

HocVBAExcel

Thành viên mớ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