Hỏi về công thức lọc tìm và so sánh viết bởi VBA (1 người xem)

Elx Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

thungdols

Thành viên chính thức
Tham gia
27/3/09
Bài viết
66
Được thích
2
Mong các bác chỉ giáo giúp em. Em dạo này hay lang thang trên trang giaiphapexcel nay nhưng chưa tim được công thức đúng như ý. Xin lỗi đã làm phiền mọi người tại em ko bit về VBA là cái chi chi cả. Mọi người tải tệp tin đính kèm rồi giải quyết giúp em nhé. Cám ơn ngàn lần
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
thungdols đã viết:
Mong các bác chỉ giáo giúp em. Em dạo này hay lang thang trên trang giaiphapexcel nay nhưng chưa tim được công thức đúng như ý. Xin lỗi đã làm phiền mọi người tại em ko bit về VBA là cái chi chi cả. Mọi người tải tệp tin đính kèm rồi giải quyết giúp em nhé. Cám ơn ngàn lần
Nhấp chuột vào đây để mở rộng...
Dữ liệu của bạn chỉ có bao nhiêu đó thôi sao. Nếu có nhiều hàng thì khi làm xong 3 hàng đầu thì lặp lại như thế nào?
 
Tất nhiên là dữ liệu của em có thể là có rất nhiều dòng. Nhưng em chỉ lấy mấy dòng cuối làm ví dụ thôi. Điều kiện sẽ là chỉ tính toán từ dòng dữ liệu cuối cùng trong bảng chính cũng như bảng phụ thôi. Cám ơn bác quan tâm. Điều em muốn ở đây là công thức để học hỏi. Chân thành cám ơn sự giúp đỡ của bác

Ngày nào em cũng ghé vô xem đã có ai hảo tâm giúp được em chưa? Nhưng em đợi hoài vẫn không có tin j cả hix bùn quá xá...**~**. Các cao thủ nhanh nhanh giúp em với. Hu hu. Ah trong dũ liệu tại bang chính em viết thừa 1 dòng. Thành thật xin lỗi. Chỉ tính toán từ dòng dữ liệu cuối cùng trở lên thôi mà. Hì Hì thành thật xin lỗi các bác
 
Chỉnh sửa lần cuối bởi điều hành viên:
Bạn viết sai một chỗ, như sau

Lần lượt kiểm tra các kí tự tại hàng 1 bảng phụ là : LT,WP,HT,UD với hàng1 bảng chính thi ta thấy kí tự HT,WP trùng lặp. Tiếp đến ta kiểm tra địa chỉ của hàng bảng chính là JF,WP có trùng với hàng 2 của bảng phụ hay không, thi ta thấy trùng lặp. Nếu có trùng thì hiện lên địa chỉ của hàng 3 sheet bang chinh là LT,DL vào ô trống
Nhấp chuột vào đây để mở rộng...

Và đây là macro của bạn:
PHP: 
Option Explicit
Sub TimTrung3Rows()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Col As Byte, jJ As Byte, VTr As Byte, DDai As Byte
 Dim StrC As String
 
 Set Sh = Sheets("Chinh"):                Col = Sh.[B2].CurrentRegion.Columns.Count
 Set Rng = Sh.[B2].Resize(, Col):         Sh.[k4] = ""
 Sheets("Phu").Select
 For jJ = 2 To 5
   StrC = Cells(2, jJ).Value
   Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)
   If Not sRng Is Nothing Then
      Dim Rng0 As Range, sRng0 As Range, StrC0 As String
      
      VTr = InStr(sRng.Value, StrC)
      DDai = Len(StrC)
      Set Rng0 = [A3].Resize(, Col)
      StrC0 = Mid(sRng.Offset(1), VTr, DDai)
      Set sRng0 = Rng0.Find(StrC0)
      If Not sRng0 Is Nothing Then
         With Sh.[k4]
            If Len(.Value) < 1 Then
               .Value = Mid(sRng.Offset(2), VTr, DDai)
            Else
               .Value = .Value & ", " & Mid(sRng.Offset(2), VTr, DDai)
            End If
            With .Interior
               If .ColorIndex = 42 Then
                  .ColorIndex = 34
               Else
                  .ColorIndex = .ColorIndex + 1
               End If
            End With
         End With
      End If   
   End If
 Next jJ
 Sh.Select:                               Set Sh = Nothing
End Sub

Chú í: Mình đã đổi tên các trang tính rồi đó nha!
 
So sánh và nhận kết quả

Rất mong các anh em trên diển đàn xem và giải quyết giúp bài toán này.
 

File đính kèm

Lần chỉnh sửa cuối:
Macro của bạn đây, xin mời!


PHP: 
Sub FindAndPlus()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Rw As Long, jJ As Long
 
 Set Sh = Sheets("Phu"):               Sheets("Chinh").Select
 Set Rng = Sh.Range(Sh.[a5], Sh.[A65500].End(xlUp))
 For jJ = 2 To 5
   Set sRng = Rng.Find(Cells(jJ, "A").Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      With sRng.Offset(, 3)
         .Value = .Value + Cells(jJ, "A").Offset(, 1).Value
         With .Offset(, 1)
            .Value = .Value + Cells(jJ, 1).Offset(, 2).Value
         End With
      End With
   End If
 Next jJ
End Sub
 
HYen17 đã viết:
PHP: 
Sub FindAndPlus()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Rw As Long, jJ As Long
 
 Set Sh = Sheets("Phu"):               Sheets("Chinh").Select
 Set Rng = Sh.Range(Sh.[a5], Sh.[A65500].End(xlUp))
 For jJ = 2 To 5
   Set sRng = Rng.Find(Cells(jJ, "A").Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      With sRng.Offset(, 3)
         .Value = .Value + Cells(jJ, "A").Offset(, 1).Value
         With .Offset(, 1)
            .Value = .Value + Cells(jJ, 1).Offset(, 2).Value
         End With
      End With
   End If
 Next jJ
End Sub
Nhấp chuột vào đây để mở rộng...
----------
Bạn có thể viết thêm đoạn code :
- Nếu có 1 mã ( Mã 20 nằm trong sheet CHINH ), không có hiện diện trong sheet PHỤ
thì ra thông báo " Không có Mã 20 " ?
Cám ơn bạn thật nhiều. Chúc bạn 1 CHỦ NHẬT TƯƠI HỒNG
 
tam8678 đã viết:
----------
Bạn viết thêm đoạn code :
- Nếu có 1 mã ( Mã 20 nằm trong sheet CHINH ), không có hiện diện trong sheet PHỤ
thì ra thông báo " Không có Mã 20 " ?
Nhấp chuột vào đây để mở rộng...

PHP: 
 Sub FindAndPlus()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Rw As Long, jJ As Long
 
 Set Sh = Sheets("Phu"):               Sheets("Chinh").Select
4 
Set Rng = Sh.Range(Sh.[a5], Sh.[A65500].End(xlUp))
 For jJ = 2 To 5
   Set sRng = Rng.Find(Cells(jJ, "A").Value, , xlFormulas, xlWhole)
   If  sRng Is Nothing Then '<=|'
        MsgBox "Khong Co " &  Cells(jJ, "A").Value   '<=|'
   else   '<=|'
      With sRng.Offset(, 3)
         .Value = .Value + Cells(jJ, "A").Offset(, 1).Value
         With .Offset(, 1)
            .Value = .Value + Cells(jJ, 1).Offset(, 2).Value
         End With
      End With
   End If
 Next jJ
18
End Sub
 
Chỉnh sửa lần cuối bởi điều hành viên:
HYen17 đã viết:
PHP: 
Sub FindAndPlus()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Rw As Long, jJ As Long
 
 Set Sh = Sheets("Phu"):               Sheets("Chinh").Select
 Set Rng = Sh.Range(Sh.[a5], Sh.[A65500].End(xlUp))
 For jJ = 2 To 5
   Set sRng = Rng.Find(Cells(jJ, "A").Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      With sRng.Offset(, 3)
         .Value = .Value + Cells(jJ, "A").Offset(, 1).Value
         With .Offset(, 1)
            .Value = .Value + Cells(jJ, 1).Offset(, 2).Value
         End With
      End With
   End If
 Next jJ
End Sub
Nhấp chuột vào đây để mở rộng...


Em nhờ bác kiểm tra lại giùm. Sau khi test thêm một mã nữa ở Sh CHINH, thêm biến jJ từ 2 đến 6 thì lại không ra kết quả. cám ơn bác
 
Xin tham gia một tý

PHP: 
Sub SoSanh()
    On Error Resume Next
    Dim m, n, i, j, k As Integer
    Dim Rng, RngKQ As Range
    Dim TimThay As Boolean
    n = Sheet2.Range("A65000").End(xlUp).Row
    m = Sheet1.Range("A65000").End(xlUp).Row
    Set Rng = Sheet2.Range("A6:A" & n)
    TimThay = False
    For i = 2 To m
        Ma = Sheet1.Range("A" & i)
        Set RngKQ = Rng.Find(What:=Ma, LookIn:=xlValues, LookAt _
            :=xlWhole, MatchCase:=True, SearchFormat:=True)
        If RngKQ Is Nothing Then
            MsgBox "Ma " & Ma & " khong co trong CSDL", , "Thong Bao"
            TimThay = False
        Else
            TimThay = True
        End If
        If TimThay = True Then
            j = RngKQ.Row
            For k = 1 To 2
                Sheet2.Cells(j, k + 3) = Sheet2.Cells(j, k + 3) + Sheet1.Cells(i, k + 1)
            Next
        End If
    Next
End Sub
 
Gởi bạn XUANTHANH.
Rất cám ơn bạn đã tham gia, nhờ bạn kiểm tra lại giúp. Hộp thông báo hiện ra không có mã hàng này => mình phải click 29 lần mới tắt được hộp thông báo này.Nhờ bạn kiểm tra giúp nhé.

Cám ơn bạn HYEN rất nhiều, nhưng còn nữa bạn ơi. Vấn đề là Sheet PHU lúc nào cũng nằm trong tình trạng Autofilter thì làm thế nào ? Phải có code gở bỏ phải không và đặt nó nằm ở đâu ? Rất mong.
 
Chỉnh sửa lần cuối bởi điều hành viên:
tam8678 đã viết:
Cám ơn bạn HYEN rất nhiều, nhưng còn nữa bạn ơi. Vấn đề là Sheet PHU lúc nào cũng nằm trong tình trạng Autofilter thì làm thế nào ? Phải có code gở bỏ phải không và đặt nó nằm ở đâu ? Rất mong.
Nhấp chuột vào đây để mở rộng...

(Mình vừa thêm các số vô dòng lệnh)

Bạn thêm các lệnh này vô chổ có đánh số xem sao:

Sh.Cells.AutoFilter '(4)'
:-=
Sh.Cells.AutoFilter '(18)'
 
HYen17 đã viết:
(Mình vừa thêm các số vô dòng lệnh)

Bạn thêm các lệnh này vô chổ có đánh số xem sao:

Sh.Cells.AutoFilter '(4)'
:-=
Sh.Cells.AutoFilter '(18)'
Nhấp chuột vào đây để mở rộng...
--------------
Nhờ bạn giải thích giúp :
Sh.Cells.AutoFilter '(4)' => Bỏ Autofilter Sheet PHỤ
Sh.Cells.AutoFilter '(18)' => Lập lại Autofilter sheet PHỤ => Nhưng muốn fải nằm trong vùng D5 : E5 sheet PHỤ thì làm thế nào ?
 
SA_DQ đã viết:
Và đây là macro của bạn:
PHP: 
Option Explicit
Sub TimTrung3Rows()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Col As Byte, jJ As Byte, VTr As Byte, DDai As Byte
 Dim StrC As String
 
 Set Sh = Sheets("Chinh"):                Col = Sh.[B2].CurrentRegion.Columns.Count
 Set Rng = Sh.[B2].Resize(, Col):         Sh.[k4] = ""
 Sheets("Phu").Select
 For jJ = 2 To 5
   StrC = Cells(2, jJ).Value
   Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)
   If Not sRng Is Nothing Then
      Dim Rng0 As Range, sRng0 As Range, StrC0 As String
 
      VTr = InStr(sRng.Value, StrC)
      DDai = Len(StrC)
      Set Rng0 = [A3].Resize(, Col)
      StrC0 = Mid(sRng.Offset(1), VTr, DDai)
      Set sRng0 = Rng0.Find(StrC0)
      If Not sRng0 Is Nothing Then
         With Sh.[k4]
            If Len(.Value) < 1 Then
               .Value = Mid(sRng.Offset(2), VTr, DDai)
            Else
               .Value = .Value & ", " & Mid(sRng.Offset(2), VTr, DDai)
            End If
            With .Interior
               If .ColorIndex = 42 Then
                  .ColorIndex = 34
               Else
                  .ColorIndex = .ColorIndex + 1
               End If
            End With
         End With
      End If   
   End If
 Next jJ
 Sh.Select:                               Set Sh = Nothing
End Sub

Chú í: Mình đã đổi tên các trang tính rồi đó nha!
Nhấp chuột vào đây để mở rộng...


Cám ơn bác. Nhưng bác xem lại giùm em là dữ liệu của em là kiểu text hết nhé chứ không phải là kiểu General đâu. Đó là lỗi tại em em ko format cell trước khi gửi lên. Cám ơn bác thêm lần nữa. Tại khi em chạy lệnh trên kiểu text thì chạy ngon nhưng ra kết quả sai bác ah (giá trị dò tìm đổi vị trí VD: tìm thấy DF thì nó so sánh cả về FD hay DF đều được)
 
Lần chỉnh sửa cuối:
Lỗi không thể như bạn nói được, mà là ở chỗ:

Vì tìm 1 cụm vài từ trong 1 chuỗi 5-7 từ nên phải dùng thông số Part trong câu lệnh:
Mã: 
Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)

Đây là điều bắt buộc!

Và khi đó lỗi có thể như sau:
Ví dụ cần tìm LN trong các cụm từ:
CLNOWD, XXXLNOA, KKDLLN, SSSNLLW, ZLNLNOP, . . . .
, thì LN có nằm đâu trong cụm từ nó đều báo có tìm thấy

Để khắc phục lỗi này, cần phải biết rõ dữ liệu của bạn;
Hay tìm nhòm từ đó chỉ & chỉ khi đứng vị trí thứ n nào đó cố định trong chuỗi
Thí dụ, chỉ tìm từ LN tại vị trí thứ 2; Khi đó trong các cụm từ trên có 2 từ được tìm thấy.
 
Hix đâu có đâu bác ơi. AH đâu thoả mãn điều kiện xuất hiện ở hàng3 đâu. cả EE cũng không thoả mãn điều kiện xuất hiện ở hàng 2 mà. Nếu không thoả mãn thì xuất ra "ô trống" là rỗng chứ. Đây lại .... hix!$@!!
 
Thành thật xin lỗi bác. Hi` Em bé cái nhầm
 
Bác SA_DQ cho em hỏi nếu dữ liệu em có nhiều dòng và muốn tính 3 dòng cuối cùng thì chỉ cần thay đổi :
Col = Sh.[B2].CurrentRegion.Columns.Count ===>>>thành ===>>> Col = Sh.Range("B65536").End(xlUp).Offset(-2, 0).CurrentRegion.Columns.Count
và:
Set Rng = Sh.[B2].Resize(, Col) ===>>> thành ===>>> Set Rng = Sh.Range("B65536").End(xlUp).Offset(-2, 0).Resize(, Col):
Phải không ah??
EM chân thành cám ơn bác
 
Bác SA_DQ cho em hỏi nếu dữ liệu em có nhiều dòng và muốn tính 3 dòng cuối cùng thì chỉ cần thay đổi :
Col = Sh.[B2].CurrentRegion.Columns.Count

&

Set Rng = Sh.[B2].Resize(, Col)
=> thành =>

Set Rng = Sh.Range("B65536").End(xlUp).Offset(-2, 0).Resize(, Col):
Nhấp chuột vào đây để mở rộng...

Bien Col nhằm lưu giữa số cột mà CSDL chiếm dụng, nếu nó bất di bất dịch thì không đổi dòng lệnh này;

Còn (2) phải vầy mới thỏa chứ:

Mã: 
Set Rng = Sh.Range("B65536").End(xlUp).Offset(-2).Resize(3, Col)

( Sau dòng lệnh đó bạn thừ thêm 2 dòng lệnh này chí ít 1 lần xem sau:

PHP: 
     MsgBox Rng.Address,,"GPE.COM"
     Exit Sub
)
 
HYen17 đã viết:
PHP: 
 Sub FindAndPlus()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Rw As Long, jJ As Long
 
 Set Sh = Sheets("Phu"):               Sheets("Chinh").Select
4 
Set Rng = Sh.Range(Sh.[a5], Sh.[A65500].End(xlUp))
 For jJ = 2 To 5
   Set sRng = Rng.Find(Cells(jJ, "A").Value, , xlFormulas, xlWhole)
   If  sRng Is Nothing Then '<=|'
        MsgBox "Khong Co " &  Cells(jJ, "A").Value   '<=|'
   else   '<=|'
      With sRng.Offset(, 3)
         .Value = .Value + Cells(jJ, "A").Offset(, 1).Value
         With .Offset(, 1)
            .Value = .Value + Cells(jJ, 1).Offset(, 2).Value
         End With
      End With
   End If
 Next jJ
18
End Sub
Nhấp chuột vào đây để mở rộng...
------------
Bạn có thể hướng dẩn thêm : trong trường hợp Sheet PHU và sheet CHINH nằm ở 2 tập tin khác nhau thì code viết như thế nào? Ví dụ như Sheet PHU nằm ở tập tin: PHU, sheet CHINH ở tập tin: CHINH, nhưng cùng nằm trong 1 Folder. Cám ơn bạn nhiều.
 
tam8678 đã viết:
------------
Bạn có thể hướng dẩn thêm : trong trường hợp Sheet PHU và sheet CHINH nằm ở 2 tập tin khác nhau thì code viết như thế nào? Ví dụ như Sheet PHU nằm ở tập tin: PHU, sheet CHINH ở tập tin: CHINH, nhưng cùng nằm trong 1 Folder. Cám ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...
-------------------
Tôi thật sự rất cần đoạn code này mong các anh em trên diển đàn hướng dẩn giúp.
 
tam8678 đã viết:
------------
Bạn có thể hướng dẩn thêm : trong trường hợp Sheet PHU và sheet CHINH nằm ở 2 tập tin khác nhau thì code viết như thế nào? Ví dụ như Sheet PHU nằm ở tập tin: PHU, sheet CHINH ở tập tin: CHINH, nhưng cùng nằm trong 1 Folder. Cám ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...
Có nhiều cách:
1/ Chép cả 2 sh của 2 file về 1 file
2/ Set Sh=MyPath & Sh...
MyPath là đừờng dẫn, hình như phải open mới được. Bạn tạo ví dụ làm thử.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

befaint
Chia sẻ tâm tư, xả nỗi lòng (5 người xem)
    • Thích
6 7 8
Trả lời
777
Đọc
72K
befaint
befaint
thanhss
Nhờ tìm công thức tính tổng theo hàng có kèm dữ liệu Text (4 người xem)
Trả lời
5
Đọc
28
dungpham01
D
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản (3 người xem)
Trả lời
4
Đọc
118
hieuvietmy2020
H
H
File excel bị lỗi không mở được (1 người xem)
Trả lời
6
Đọc
45
hiep204
H
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA
    • Thích
Trả lời
10
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
A
  • Question Question
Sửa code VBA nhập liệu userform (1 người xem)
Trả lời
24
Đọc
979
ongke0711
ongke0711
SA_DQ
Copilot & bài thơ chia bánh do 'Hắn' sáng tác
Trả lời
2
Đọc
60
SA_DQ
SA_DQ
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (***Nguồn cấp FreeMeteo đã dừng cấp dữ liệu lịch sử)
    • Thích
    • Yêu thích
Trả lời
90
Đọc
25K
dinhhoangcd13
D
T
GẤP: TÌM GIÁ THEO TỪNG KHÁCH (1 người xem)
Trả lời
7
Đọc
335
tulipviet
T
D
lấy thẻ kho từ sổ kho nên dùng hàm nào ah (1 người xem)
Trả lời
3
Đọc
82
dankedun
D
L
công thứ tìm giá trị giao hàng với cột
Trả lời
13
Đọc
198
luongcongdua
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
552
Đọc
70K
ongke0711
ongke0711
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
1
Đọc
107
thanthanhan
thanthanhan
SA_DQ
Tìm số chính phương trong 1 biểu thức cho trước
    • Thích
    • Yêu thích
Trả lời
22
Đọc
355
dungpham01
D
T
TỈNH TỔNG TỪNG Ô THEO ĐIỀU KIỆN (1 người xem)
Trả lời
3
Đọc
123
thanthanhan
thanthanhan
8
Tính tổng điểm 3 môn theo tổ hợp xét tuyển (1 người xem)
Trả lời
3
Đọc
97
ptm0412
ptm0412
N
  • Question Question
Tool chia băng kết hợp bên ngành tôn
Trả lời
0
Đọc
96
nguyenanhtruong2409
N
S
Chỉnh công thức tính tỷ lệ hoàn thành giúp mình với.
Trả lời
8
Đọc
477
ptm0412
ptm0412
L
Tìm giải pháp trừ lùi nguyên liệu xuất nhập khẩu
Trả lời
9
Đọc
312
luongcongdua
L
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
31
Đọc
2K
Hoàng Tuấn 868
H
Xem thêm…

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

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

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom