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

[thungdols]

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

 

[huuthang_bd]

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

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?

 

[thungdols]

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

 

[SA_DQ]

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

Và đây là macro của bạn:

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!

 

[tam8678]

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.

 

[SA_DQ]

Macro của bạn đây, xin mời!

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

 

[tam8678]

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

----------
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

 

[SA_DQ]

----------
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 " ?

 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

 

[XuanThanh]

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

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

 

[XuanThanh]

Xin tham gia một tý

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

 

[tam8678]

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.

 

[SA_DQ]

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.

(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)'

 

[tam8678]

(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ờ 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 ?

 

[thungdols]

Và đây là macro của bạn:

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!

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)

 

[SA_DQ]

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:

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.

 

[thungdols]

View attachment Book1.xls Bác coi lại hộ em nha. Em cám ơn bác nhiều! Mong tin bác

 

[SA_DQ]

View attachment 28416 Bác coi lại hộ em nha. Em cám ơn bác nhiều! Mong tin bác

Mình vừa tải về & chạy thử thấy vẫn đúng mà;

Tại [k4] mà bạn trộn lại đó nó chứa chuỗi DG, IH, GG, EG

& cứ sau mỗi lần chạy, ô trộn này đổi màu (cho vui cửa vui nhà í mà!), nhưng trị vẫn là đó mà thôi.

 

[thungdols]

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

 

[thungdols]

Thành thật xin lỗi bác. Hi` Em bé cái nhầm

 

[thungdols]

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