Nhờ giúp đỡ code VBA giải quyết các vấn đề lọc, tìm kiếm giá trị (vì sử dụng công thức bị chậm)

Liên hệ QC
K

kienphamiuh

Thành viên chính thức
Tham gia
8/12/18
Bài viết
66
Được thích
11
Chào anh chị ! em có file excel này nhờ anh chị viết giúp code , trong file excel em có ghi rõ các vấn đề nhờ anh chị giúp. anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ :)
-Ngoài ra em cũng mới biết VBA được 2 tháng , đang rất muốn học anh chị nào có lớp dạy hoặc biết chỗ nào dạy tốt chỉ giúp em ạ, em ở khu vực TP HCM, huyện Bình Chánh gần cuối đường Nguyễn Văn Linh ạ
 

File đính kèm

  • file gửi GPE.xlsx
    30.1 KB · Đọc: 19
Sắp xếp theo thời gian sắp xếp theo bầu chọn
kienphamiuh đã viết:
Chào anh chị ! em có file excel này nhờ anh chị viết giúp code , trong file excel em có ghi rõ các vấn đề nhờ anh chị giúp. anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ :)
-Ngoài ra em cũng mới biết VBA được 2 tháng , đang rất muốn học anh chị nào có lớp dạy hoặc biết chỗ nào dạy tốt chỉ giúp em ạ, em ở khu vực TP HCM, huyện Bình Chánh gần cuối đường Nguyễn Văn Linh ạ
Nhấp chuột vào đây để mở rộng...
Xong cái điều kiện 1.
Bạn xem.
Mã: 
Sub timkiem1()
Dim a As Long, b As Long, c As Long, i As Long, j As Long, k As Long
Dim arr, arr1
Dim dk As String, dks As String
Dim aT, T, aso()
With Sheets("danh sach tong")
     b = .Range("B" & Rows.Count).End(xlUp).Row
     If b < 3 Then MsgBox "khong co du lieu": Exit Sub
     arr = .Range("A4:P" & b).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 6)
End With
With Sheets("ket qua")
     T = Array(.Range("b3").Value, .Range("b4").Value, .Range("b5").Value)
     aT = Array(14, 15, 16)
     For i = LBound(T) To UBound(T)
         If T(i) <> Empty Then
            c = c + 1
            If dk = Empty Then
               dk = T(i)
            Else
               dk = dk & "#" & T(i)
            End If
          ReDim Preserve aso(1 To c)
           aso(c) = aT(i)
         End If
     Next i
For i = 1 To UBound(arr, 1)
    dks = Empty
    On Error Resume Next
    For k = LBound(aso) To UBound(aso)
        If dks = Empty Then
           dks = arr(i, aso(k))
        Else
           dks = dks & "#" & arr(i, aso(k))
        End If
    Next k
    If UCase(dk) = UCase(dks) Then
       a = a + 1
       arr1(a, 1) = a
       arr1(a, 2) = arr(i, 2)
       arr1(a, 3) = arr(i, 5)
       arr1(a, 4) = arr(i, 8)
       arr1(a, 5) = arr(i, 9)
       arr1(a, 6) = arr(i, 10)
     End If
Next i
c = .Range("E" & Rows.Count).End(xlUp).Row
If c > 2 Then .Range("D3:i" & c).ClearContents
If a Then .Range("D3").Resize(a, 6).Value = arr1
End With
End Sub
 

File đính kèm

  • file gửi GPE.xlsm
    40 KB · Đọc: 12
Upvote 0
snow25 đã viết:
Xong cái điều kiện 1.
Bạn xem.
Mã: 
Sub timkiem1()
Dim a As Long, b As Long, c As Long, i As Long, j As Long, k As Long
Dim arr, arr1
Dim dk As String, dks As String
Dim aT, T, aso()
With Sheets("danh sach tong")
     b = .Range("B" & Rows.Count).End(xlUp).Row
     If b < 3 Then MsgBox "khong co du lieu": Exit Sub
     arr = .Range("A4:P" & b).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 6)
End With
With Sheets("ket qua")
     T = Array(.Range("b3").Value, .Range("b4").Value, .Range("b5").Value)
     aT = Array(14, 15, 16)
     For i = LBound(T) To UBound(T)
         If T(i) <> Empty Then
            c = c + 1
            If dk = Empty Then
               dk = T(i)
            Else
               dk = dk & "#" & T(i)
            End If
          ReDim Preserve aso(1 To c)
           aso(c) = aT(i)
         End If
     Next i
For i = 1 To UBound(arr, 1)
    dks = Empty
    On Error Resume Next
    For k = LBound(aso) To UBound(aso)
        If dks = Empty Then
           dks = arr(i, aso(k))
        Else
           dks = dks & "#" & arr(i, aso(k))
        End If
    Next k
    If UCase(dk) = UCase(dks) Then
       a = a + 1
       arr1(a, 1) = a
       arr1(a, 2) = arr(i, 2)
       arr1(a, 3) = arr(i, 5)
       arr1(a, 4) = arr(i, 8)
       arr1(a, 5) = arr(i, 9)
       arr1(a, 6) = arr(i, 10)
     End If
Next i
c = .Range("E" & Rows.Count).End(xlUp).Row
If c > 2 Then .Range("D3:i" & c).ClearContents
If a Then .Range("D3").Resize(a, 6).Value = arr1
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Chắc anh chưa hiểu ý em rồi, CODE điều kiện 1 phải thoả hết 3 điều kiên của ô B3 B4 B5 luôn anh , ý của điều kiện 1 là trong file "DANH SACH TONG" có rất nhiều lớp, ca học, GVPT . mình cho vào 3 giá trị điều kiên B3 B4 B5 để lọc trong "DANH SACH TONG" các học viên thoả 3 tiêu chí đó.
Em vd: em muốn lọc ( B3: FF1 , B4:246/5:30pm, B5: Ms. Tuyền ) thì khi bấm nút điều kiện 1 chỉ ra đáp án các học viên đang học lớp đó, như trong file là 21 học viên, chứ ko phải là 32 học viên như trong file anh gửi ạ
-Ngoài ra ở ô SĐT1 và SĐT2 em muốn lấy giá trị và cả comment , màu sắc chữ ( ở đây là chữ màu đỏ và đen )
- Ngoài ra cột STT của sheet " KET QUA " là lấy từ cột A của sheet " DANH SACH TONG", Vì em muốn lấy cột STT của sheet "KET QUA" để đi dò tìm vì nó là "dạng số", anh coi thử sheet "DANH SACH TONG" cái cột STT nó là những số cuối của MBL chứ ko phải là số thứ tự bình thường ạ .
- Nhờ anh sửa lại code giúp em nhé :)
 
Lần chỉnh sửa cuối:
Upvote 0
kienphamiuh đã viết:
Chắc anh chưa hiểu ý em rồi, CODE điều kiện 1 phải thoả hết 3 điều kiên của ô B3 B4 B5 luôn anh , ý của điều kiện 1 là trong file "DANH SACH TONG" có rất nhiều lớp, ca học, GVPT . mình cho vào 3 giá trị điều kiên B3 B4 B5 để lọc trong "DANH SACH TONG" các học viên thoả 3 tiêu chí đó.
Em vd: em muốn lọc ( B3: FF1 , B4:246/5:30pm, B5: Ms. Tuyền ) thì khi bấm nút điều kiện 1 chỉ ra đáp án các học viên đang học lớp đó, như trong file là 24 học viên, chứ ko phải là 32 học viên như trong file anh gửi ạ
-Ngoài ra ở ô SĐT1 và SĐT2 em muốn lấy giá trị và cả comment , màu sắc chữ ( ở đây là chữ màu đỏ và đen )
- Ngoài ra cột STT của sheet " KET QUA " là lấy từ cột A của sheet " DANH SACH TONG", Vì em muốn lấy cột STT của sheet "KET QUA" để đi dò tìm vì nó là "dạng số", anh coi thử sheet "DANH SACH TONG" cái cột STT nó là những số cuối của MBL chứ ko phải là số thứ tự bình thường ạ .
- Nhờ anh sửa lại code giúp em nhé :)
Nhấp chuột vào đây để mở rộng...
Bạn xem và test lại đi đúng mà.Mình không lấy được màu chữ và comment đâu.Còn STT mình đã chỉnh.
 

File đính kèm

  • file gửi GPE.xlsm
    39.8 KB · Đọc: 10
Upvote 0
kienphamiuh đã viết:
Chào anh chị ! em có file excel này nhờ anh chị viết giúp code , trong file excel em có ghi rõ các vấn đề nhờ anh chị giúp. anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ :)
-Ngoài ra em cũng mới biết VBA được 2 tháng , đang rất muốn học anh chị nào có lớp dạy hoặc biết chỗ nào dạy tốt chỉ giúp em ạ, em ở khu vực TP HCM, huyện Bình Chánh gần cuối đường Nguyễn Văn Linh ạ
Nhấp chuột vào đây để mở rộng...

Cách VBA tốt nhất trường hợp của bạn là dùng
- ghi macro
- filter theo điều kiện
- Copy ->paste
Thì sẽ được như ý

Rồi hiệu chỉnh macro lại cho chuẩn hóa các cột (có thể dùng vòng lặp hay gì đó)

vì bạn đang học VBA nên giúp cách như trên
 
Upvote 0
kienphamiuh đã viết:
hậu tạ
Nhấp chuột vào đây để mở rộng...
.
Mình thích nhất khúc này. Nhiều bài đã đăng như vậy mà chưa bao giờ thành hiện thực.

----------
Xem bài này có bị xóa không?

- Chủ thớt đã sửa lại tiêu đề: Bị cắt khúc đuôi và giờ đã thêm đuôi mới "(vì sử dụng công thức bị chậm)"

- Thêm nội dung mới: "anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ".

- Bài này chủ thớt đã đăng 2 lần rồi. Vậy giờ xử lý sao đây.

https://www.giaiphapexcel.com/diend...-những-thắc-mắc-về-code-vba.83698/post-895663

https://www.giaiphapexcel.com/diend...-formats-comments-của-ô-được-tìm-kiếm.139556/
 
Upvote 0
befaint đã viết:
.
Mình thích nhất khúc này. Nhiều bài đã đăng như vậy mà chưa bao giờ thành hiện thực.

----------
Xem bài này có bị xóa không?

- Chủ thớt đã sửa lại tiêu đề: Bị cắt khúc đuôi và giờ đã thêm đuôi mới "(vì sử dụng công thức bị chậm)"

- Thêm nội dung mới: "anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ".

- Bài này chủ thớt đã đăng 2 lần rồi. Vậy giờ xử lý sao đây.

https://www.giaiphapexcel.com/diendan/threads/chuyên-đề-giải-đáp-những-thắc-mắc-về-code-vba.83698/post-895663

https://www.giaiphapexcel.com/diendan/threads/xin-mã-vba-như-hàm-vloopkup-nhưng-lấy-được-cả-formats-comments-của-ô-được-tìm-kiếm.139556/
Nhấp chuột vào đây để mở rộng...
- anh nói vậy là sai, cái tiêu đề là em có ghi hậu ta là đúng và thêm " vì sử dụng công thức bị chậm " là đúng
- câu "anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ" là em viết từ lúc đăng bài , anh nói em thêm sau này là sai
- đúng là em đã đăng 2 bài nhưng 2 nội dung khác nhau, bài đăng đầu tiên của em là nhờ giúp đỡ, không hề có chữ " hậu tạ " có Oanh Thơ là chứng.
- còn vấn đề hậu tạ em nói là em làm, em xin sđt người viết được code cho em để em gửi cad đt
- còn về vấn đề anh em thấy lúc nào cũng vào bài đăng của em đã không giúp được còn hay bới móc người khác
Bài đã được tự động gộp:

kienphamiuh đã viết:
- anh nói vậy là sai, cái tiêu đề là em có ghi hậu ta là đúng và thêm " vì sử dụng công thức bị chậm " là đúng
- câu "anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ" là em viết từ lúc đăng bài , anh nói em thêm sau này là sai
- đúng là em đã đăng 2 bài nhưng 2 nội dung khác nhau, bài đăng đầu tiên của em là nhờ giúp đỡ, không hề có chữ " hậu tạ " có Oanh Thơ là chứng.
- còn vấn đề hậu tạ em nói là em làm, em xin sđt người viết được code cho em để em gửi cad đt
- còn về vấn đề anh em thấy lúc nào cũng vào bài đăng của em đã không giúp được còn hay bới móc người khác
Nhấp chuột vào đây để mở rộng...
- còn nếu anh giúp được em code chạy ok, thì để lại sđt , em sẽ hậu tạ
 
Upvote 0
kienphamiuh đã viết:
- anh nói vậy là sai, cái tiêu đề là em có ghi hậu ta là đúng và thêm " vì sử dụng công thức bị chậm " là đúng
Nhấp chuột vào đây để mở rộng...
. Anh nick màu đỏ "cắt" khúc đuôi tiêu đề bài của bạn mà không thông báo với bạn à?
. Thớt này trước đó có ba bài đã được anh nick màu đỏ xóa rồi. Bạn cũng đâu biết. :)
. Đang nhiều bài cùng nội dung (lấy giá trị, màu, ghi chú) là vi phạm nội quy. => Anh nick màu đỏ khóa/ xóa cả thớt này.
. Bài trên là bằng chứng cho câu "tao không sợ a e GPE". Nói mọi người không tin.
. Từ khóa: nick màu đỏ.
 
Upvote 0
befaint đã viết:
. Anh nick màu đỏ "cắt" khúc đuôi tiêu đề bài của bạn mà không thông báo với bạn à?
. Thớt này trước đó có ba bài đã được anh nick màu đỏ xóa rồi. Bạn cũng đâu biết. :)
. Đang nhiều bài cùng nội dung (lấy giá trị, màu, ghi chú) là vi phạm nội quy. => Anh nick màu đỏ khóa/ xóa cả thớt này.
. Bài trên là bằng chứng cho câu "tao không sợ a e GPE". Nói mọi người không tin.
. Từ khóa: nick màu đỏ.
Nhấp chuột vào đây để mở rộng...
- em chỉ thấy cái tiêu đề bị cắt em nghĩ do viết vậy là không đúng nội quy, nên em mới sửa lại câu tiêu đề, chứ em không thấy ai thông báo gì hết
- em mới vào GPE ngày hôm qua có đăng 1 comment trong kia có được bạn Oanh Thơ trả lời , xong Oanh Thơ nói em nên đăng bài bên ngoài, trong chỗ em comment chỉ là trả lời thắc mắc những code đã viết rồi
- xong em ra ngoài tạo 1 bài đăng và vấn đề bài đăng đó đã được giải quyết xong
- hôm nay em đăng bài này là nôi dung khác bài kia không về giống nhau.
 
Upvote 0
befaint đã viết:
. Anh nick màu đỏ "cắt" khúc đuôi tiêu đề bài của bạn mà không thông báo với bạn à?
. Thớt này trước đó có ba bài đã được anh nick màu đỏ xóa rồi. Bạn cũng đâu biết. :)
. Đang nhiều bài cùng nội dung (lấy giá trị, màu, ghi chú) là vi phạm nội quy. => Anh nick màu đỏ khóa/ xóa cả thớt này.
. Bài trên là bằng chứng cho câu "tao không sợ a e GPE". Nói mọi người không tin.
. Từ khóa: nick màu đỏ.
Nhấp chuột vào đây để mở rộng...
- cảm ơn anh đã góp ý, lần sau em sẽ rút kinh nghiệm về việc đăng bài.
- nhưng anh cho em hỏi nếu bài đăng có tiêu đề hoặc nội dung là " viết code lấy công viết" hoặc "hậu tạ" để cảm ơn người viết code cho mình là có vi phạm GPE không?
 
Upvote 0
kienphamiuh đã viết:
chắc phải đợi các anh chị kia viết code, code của anh là ok rồi đúng ý của điều kiện 1 nhưng thiếu mỗi cái lấy màu chữ với comment
Nhấp chuột vào đây để mở rộng...

Bạn thử đoạn dưới cho điều kiện 1 xem được không ạ:
Mã: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Application.ScreenUpdating = False
    Dim i As Long
    With Sheets("DANH SACH TONG"): .Select
        .Range("N3:P3").Copy .Range("BT2")
         Sheets("KET QUA").Range("B3:B5").Copy
        .Range("BT3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        i = .Range("B" & .Rows.Count).End(xlUp).Row: If i < 3 Then Exit Sub
        .Range("A3:P" & i).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("BT2:BV3"), CopyToRange:=Range("BT4"), Unique:=False
        i = .Range("BT" & .Rows.Count).End(xlUp).Row
        If i < 5 Then .Columns("AT:BI").Delete
        .Range("BT5:BU" & i).Copy Sheets("KET QUA").Range("D3:D" & i - 2)
        .Range("BX5:BX" & i).Copy Sheets("KET QUA").Range("F3:F" & i - 2)
        .Range("CA5:CC" & i).Copy Sheets("KET QUA").Range("G3:I" & i - 2)
        .Columns("BT:CI").Delete
    End With
    Sheets("KET QUA").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Bạn thử đoạn dưới cho điều kiện 1 xem được không ạ:
Mã: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Application.ScreenUpdating = False
    Dim i As Long
    With Sheets("DANH SACH TONG"): .Select
        .Range("N3:P3").Copy .Range("BT2")
         Sheets("KET QUA").Range("B3:B5").Copy
        .Range("BT3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        i = .Range("B" & .Rows.Count).End(xlUp).Row: If i < 3 Then Exit Sub
        .Range("A3:P" & i).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("BT2:BV3"), CopyToRange:=Range("BT4"), Unique:=False
        i = .Range("BT" & .Rows.Count).End(xlUp).Row
        If i < 5 Then .Columns("AT:BI").Delete
        .Range("BT5:BU" & i).Copy Sheets("KET QUA").Range("D3:D" & i - 2)
        .Range("BX5:BX" & i).Copy Sheets("KET QUA").Range("F3:F" & i - 2)
        .Range("CA5:CC" & i).Copy Sheets("KET QUA").Range("G3:I" & i - 2)
        .Columns("BT:CI").Delete
    End With
    Sheets("KET QUA").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Oanh Thơ bạn coi lại code mình cho vào nút bấm điều kiện 1 nó không chạy được, không biết lỗi chỗ nào
 
Upvote 0
VetMini đã viết:
Thế là toi quách một dịp kiếm chút cà phê. :(:(:(
@thớt: nếu cái phần "tiếp tục" kia cái cô nọ làm không ra thì bạn còn ý "hậu tạ" cho người làm hôn?
Nhấp chuột vào đây để mở rộng...
mong Oanh Thơ làm được vì bạn này cũng hay giúp mình nhiều cái lắm :), nếu Oanh Thơ làm khồng được mình cũng gửi 1 ít gọi là tấm lòng :)
 
Upvote 0
kienphamiuh đã viết:
đúng rồi Oanh Thơ, tiếp tục nút điều kiện 2 đi bạn, cái nút reset chủ yếu là xoá ô B3 B4 B5 B6 và xoá luôn từ D3 đến L3 đến dòng cuối nha, like
Nhấp chuột vào đây để mở rộng...

Thực ra Oanh Thơ (OT) có đọc điều kiện 2 của bạn rồi nhưng chưa hiểu ý bạn, bạn viết
+ Nhấn nút Điều Kiện 2:
* tại ô ĐÃ CÓ SÁCH: dựa vào 2 điều kiện B6 và D6 tìm kiếm học viên đã có sách từ sheet " TANG VA BAN "
** đối với các học viên đã có sách:
- ô ĐÃ CÓ SÁCH: cho ra kết quả trùng với mã sách
- ô GHI CHÚ và NGÀY: thông tin 2 ô này lấy từ sheep"TANG VA BAN" cột F và P trùng với kết quả học viên có sách
** đối với các học viên không có sách để trống ô
Nhấp chuột vào đây để mở rộng...
B6 và D6 và D6 của sheet nào vậy bạn, OT nghĩ rằng bạn nói đến sheet "KET QUA" nhưng trong Sheet này cột D có nhiều mã nhiều STT mà. sao lại lấy mỗi D6? và còn các dòng tiếp theo nữa.

Bạn nên cho kết quả minh họa, sau khi bấm nút điều kiện 2 xong thì kết quả nó hiển thi trên sheet "KET QUA" .
Với lại Ot nghĩ, tiêu đề bạn có đề cập"vì sử dụng công thức bị chậm" bạn nên giữ nguyên công thức để mọi người cùng xem vì sao nặng sau đó mới góp ý cho bạn giải pháp được chứ. Nếu dữ liệu nhiều bạn có thể xóa bớt để lại một ít để làm ví dụ chẳng hạn.
------------
OT không dám hứa là sẽ giúp được bạn cái nút điều kiện 2 ạ, chỉ là OT chưa hiểu nên xác nhận lại để các bạn khác cùng xem và giúp bạn.
Có thể bạn @snow25 cũng định giúp bạn nốt nhưng vó thể vì bạn ấy chưa hiểu cũng nên.
 
Upvote 0
Thế là phần mình hoàn toàn mất cỗ lòng rồi. Chén mắm tôm vắt chanh ớt sẵn đành đem đổ thôi.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
Trích Lọc dữ liệu với Macro
Trả lời
18
Đọc
1K
HTN033
H
LuuAnh980
Filter lọc có "mm" mà không thấy.
Trả lời
3
Đọc
83
VetMini
V
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
3
Đọc
81
VetMini
V
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
4
Đọc
124
VetMini
V
C
  • Question
Tạo schedule chạy code VBA
Trả lời
8
Đọc
264
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom