求VBA 批量对比数据

Question

区域1： Sheets("1").Range("A1:F240")，每行6个数（互不相同），240行
区域2： Sheets("2").Range("A1:F240")，每行6个数（互不相同），240行
要把区域1与区域2对应的行作比较，比如，区域1的第1行的第1个数、第2个...第6个，分别与区域2的第1行所有数据比较，共6*6=36次，如果存在至少4个相等的情况，在Sheets("1").Range("G1")中返回1，否则为0。
然后再用区域1的第2行与区域2的第2行进行比较，返回值在G2。
继续完成其他行的比较。
测试时我是用randbetween(1,100)在两个表单中生成随机数，然后把随机公式粘贴成数字。
以下是以前网友帮写的，很好用。当时要求区域1中有任意一个数等于区域2中的任意一个数，就返回为1。而现在的要求是区域1中至少有4个数与区域2中的6个中的4个相等才能返回1：
Sub t1()
Dim a1, a2, i%, j%, s$
    a1 = Sheets("1").Range("A1:F240")
    a2 = Sheets("2").Range("A1:F240")
    For i = 1 To UBound(a1)
        s = "," & Join(Application.Index(a1, i), ",") & ","
        For j = 1 To UBound(a1, 2)
            If InStr(1, s, "," & a2(i, j) & ",") > 0 Then
                Sheets("1").Range("G" & i) = 1
                Exit For
            End If
        Next
        If j = 6 Then Sheets("1").Range("G" & i) = 0
    Next
End Sub

Answer 1

稍加改动即可：
Sub t1()
Dim a1, a2, i%, j%, s$, k&
    a1 = Sheets("1").Range("A1:F240")
    a2 = Sheets("2").Range("A1:F240")
    For i = 1 To UBound(a1)
        s = "," & Join(Application.Index(a1, i), ",") & ","
        k = 0
        For j = 1 To UBound(a1, 2)
            If InStr(1, s, "," & a2(i, j) & ",") > 0 Then k = k + 1
        Next
        Sheets("1").Range("G" & i) = k
    Next
End Sub