Viết hàm kiểm tra bằng vb

  • Thread starter Thread starter conan198
  • Ngày gửi Ngày gửi
Liên hệ QC

conan198

Thành viên mới
Tham gia
17/5/10
Bài viết
17
Được thích
0
Mọi người giúp mình tý,
Vấn đề như sau: Có 2 sheets
sheets 1 có hai cột và nhiều dòng
sheets 2 cũng vậy
Và mình phải viết đoạn code kiểm tra xem có hàng nào ở sheets 2 giống sheets 1 không
trong ví dụ:
với mỗi hàng với hai cột ở sheets 2 có bằng hàng nào trong sheets 1 hay không nếu có ghi vào hàng đó và cột tiếp theo của sheets 2 "CO", hoặc "KHONG"
Xin cảm ơn
 

File đính kèm

Bạn thử với hàm này xem sao?

PHP:
Option Explicit
Function TimTrung(Tri As Range, Vung As Range)
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Clls As Range
 Dim Rws As Long, Col As Byte, Khg As Boolean
 
 Set Sh = ThisWorkbook.Worksheets(Vung.Parent.Name)
 If Vung.Columns.Count > 1 Then
    TimTrung = "Tìm Trong Cot Mà Thoi":     Exit Function
 End If
 TimTrung = "No"
 For Each Cls In Vung
    If Cls.Value = Tri.Value Then
        Rws = Cls.Row:                      Khg = False
        Col = Sh.Cells(Rws, "iU").End(xlToLeft).Column
        Set Rng = Sh.Range(Sh.Cells(Rws, 1), Sh.Cells(Rws, Col))
        For Each Clls In Rng
            If Clls.Value <> Cells(Tri.Row, Clls.Column) Then
                Khg = True:                 Exit For
            End If
        Next Clls
        If Khg = False Then
            TimTrung = "Yes":               Exit Function
        End If
    End If
 Next Cls
End Function

Cách dùng: Tại [E3] của trang 'gt2' bạn nhập cú fáp =TimTrung(C3,'gt1'!C$3:C$6)
& dùng FillDown chép xuống các ô dưới;

/(/hưng nếu dùng macro để điền kết quả sẽ nhanh hơn về tốc độ.
 
Upvote 0
Cảm ơn

PHP:
Option Explicit
Function TimTrung(Tri As Range, Vung As Range)
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Clls As Range
 Dim Rws As Long, Col As Byte, Khg As Boolean
 
 Set Sh = ThisWorkbook.Worksheets(Vung.Parent.Name)
 If Vung.Columns.Count > 1 Then
    TimTrung = "Tìm Trong Cot Mà Thoi":     Exit Function
 End If
 TimTrung = "No"
 For Each Cls In Vung
    If Cls.Value = Tri.Value Then
        Rws = Cls.Row:                      Khg = False
        Col = Sh.Cells(Rws, "iU").End(xlToLeft).Column
        Set Rng = Sh.Range(Sh.Cells(Rws, 1), Sh.Cells(Rws, Col))
        For Each Clls In Rng
            If Clls.Value <> Cells(Tri.Row, Clls.Column) Then
                Khg = True:                 Exit For
            End If
        Next Clls
        If Khg = False Then
            TimTrung = "Yes":               Exit Function
        End If
    End If
 Next Cls
End Function

Cách dùng: Tại [E3] của trang 'gt2' bạn nhập cú fáp =TimTrung(C3,'gt1'!C$3:C$6)
& dùng FillDown chép xuống các ô dưới;

/(/hưng nếu dùng macro để điền kết quả sẽ nhanh hơn về tốc độ.
Mình cảm ơn bạn đã trả lời, nhưng mình muốn kiểm tra cả hai giá trị ở hai cột, trong ví dụ mình gửi lên đó có hàng cuối cùng là trùng nhau. Mong bạn viết lại giúp mình
 
Upvote 0
Mình cảm ơn bạn đã trả lời, nhưng mình muốn kiểm tra cả hai giá trị ở hai cột, trong ví dụ mình gửi lên đó có hàng cuối cùng là trùng nhau. Mong bạn viết lại giúp mình

Chưa rõ í bạn lắm; Nhưng nếu tại [E6] của 'gt2' ta áp công thức: =TimTrung(A6,'gt1'!A$3:A$6) thì cũng nhận được từ 'Yes' mà!

Từ ấy nói lên 1 điều, rằng các ô trong hàng đó của 2 trang tính là như nhau về trị tương ứng

 
Upvote 0
Mọi người giúp mình tý,
Vấn đề như sau: Có 2 sheets
sheets 1 có hai cột và nhiều dòng
sheets 2 cũng vậy
Và mình phải viết đoạn code kiểm tra xem có hàng nào ở sheets 2 giống sheets 1 không
trong ví dụ:
với mỗi hàng với hai cột ở sheets 2 có bằng hàng nào trong sheets 1 hay không nếu có ghi vào hàng đó và cột tiếp theo của sheets 2 "CO", hoặc "KHONG"
Xin cảm ơn
Bạn thử cái này xem
Mã:
Public Sub Trung()
    Dim d, Vung, VungDo, I, K, Mg(), J, M, kK
    Set d = CreateObject("scripting.dictionary")
    Set Vung = Sheets("gt1").Range(Sheets("gt1").[a3], Sheets("gt1").[a1000].End(xlUp))
    Vung.Resize(, 3).Interior.ColorIndex = xlNone
        For I = 1 To Vung.Rows.Count
            If Not d.exists(Vung(I) & Vung(I).Offset(, 2)) Then
                K = K + 1
                d.Add Vung(I) & Vung(I).Offset(, 2), K
            End If
        Next I
     Set VungDo = Range([a3], [a1000].End(xlUp)).Resize(, [aa3].End(xlToLeft).Column)
     VungDo.Interior.ColorIndex = xlNone
     J = VungDo.Columns.Count: kK = 2
     ReDim Mg(1 To VungDo.Rows.Count, 1 To 1)
            For I = 1 To VungDo.Rows.Count
                If d.exists(VungDo(I, 1) & VungDo(I, J)) Then
                    kK = kK + 1
                    M = d.Item(VungDo(I, 1) & VungDo(I, J))
                    Union(Vung(M), Vung(M).Offset(, 2)).Interior.ColorIndex = kK
                    Union(VungDo(I, 1), VungDo(I, J)).Interior.ColorIndex = kK
                    Mg(I, 1) = "Trùng, voi hàng thu: " & M & "  trong bang GÌ DÓ o sheet gt1"
                End If
            Next I
     [aa3].End(xlToLeft).Offset(, 1).Resize(VungDo.Rows.Count) = Mg
End Sub
Bạn nhập đủ dữ liệu sang sheet :gt2" bấm nút
Thân
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom