|
楼主 |
发表于 2016-3-28 21:28
|
显示全部楼层
爱疯 发表于 2016-3-28 18:54
http://www.excelpx.com/thread-387038-1-1.html
重复了
当然知道发相同问题了
第一种你写的,
Sub test()
Dim A, B, i, j, k, x, y
A = [j8:m14]
B = Range("c8").CurrentRegion
For k = 1 To UBound(A)
A(k, 4) = 0
For i = 2 To UBound(B)
x = False
For j = 1 To UBound(B, 2)
If B(i, j) = A(k, 1) Then x = True: Exit For
Next j
y = False
For j = 1 To UBound(B, 2)
If B(i, j) = A(k, 2) Then y = True: Exit For
Next j
If x And y Then A(k, 4) = A(k, 4) + 1
Next i
Next k
[m8:m14] = Application.Index(A, 0, 4)
End Sub
第二种
Sub pl()
Dim rg1 As Range: Dim i, r, n As Integer: Dim f
r = Cells(Rows.Count, "J").End(xlUp).Row
For i = 8 To r
For Each rg In Range("C8:C23")
Set f = rg.Resize(1, 6).Find(Cells(i, "J").Value, LookAt:=xlWhole)
If Not f Is Nothing Then
Set f = rg.Resize(1, 6).Find(Cells(i, "K").Value)
If Not f Is Nothing Then n = n + 1
End If
Next
Cells(i, "L").Value = n: n = 0
Next
End Sub
第三种
Sub s()
arr = [C8:H23]
For i = 8 To 14
c = 0
For j = 1 To 16
b = Cells(i, 10)
For k = 1 To 6
If arr(j, k) = b Then
b = Cells(i, 11)
For l = 1 To 6
If arr(j, l) = b Then c = c + 1: GoTo 1
Next
End If
Next
1:
Next
Cells(i, 12) = c
Next
End Sub
第四种
Function mySum(ByVal rg1 As Range, rg2 As Range) As Integer
Dim k As Integer
k = 0
For i = 1 To rg1.Rows.Count
If Application.CountIf(rg1.Cells(1, 1).Offset(i - 1, 0).Resize(1, rg1.Columns.Count), rg2.Cells(1, 1)) _
And Application.CountIf(rg1.Cells(1, 1).Offset(i - 1, 0).Resize(1, rg1.Columns.Count), rg2.Cells(1, 2)) Then
k = k + 1
End If
Next i
mySum = k
End Function
|
|