|
感觉还是没看懂,也不好意思再问了。总要有个行动,就瞎写一个吧。你先看下截图,如果不对代码就别看了:
没传文件,主要是觉得没理解你的意思,只发个参考代码;
重点就是两个函数,尤其第二个函数def,是判断历史记录中不能有重复,我感觉关键点就在那个函数里中的逻辑对不对了,关键的地方我做了备注,你可以根据需要适当变化;
sub 按钮1_Click()
[d:d].Clear
Dim arr()
js = 1
For i = 1 To [a65000].End(3).Row
For k = 1 To [b65000].End(3).Row
ReDim Preserve arr(1 To js)
arr(js) = Cells(i, 1) & Cells(k, 2)
js = js + 1
Next k
Next i
Dim brr()
js = 1
For i = 1 To UBound(arr)
For k = i + 1 To UBound(arr)
s1 = arr(i)
s2 = arr(k)
If js > 1 Then
If Not def((s1), (s2), brr) Then
If Not abc((s1), (s2)) Then
ReDim Preserve brr(js)
brr(js) = s1 & "-" & s2
js = js + 1
End If
End If
Else
ReDim Preserve brr(js)
brr(js) = s1 & "-" & s2
js = js + 1
End If
Next k
Next i
For i = 1 To UBound(brr)
Cells(i, 4) = brr(i)
Next i
End Sub
Function abc(x1 As String, x2 As String) As Boolean '此函数判断该组对手不能重复
xx1 = Mid(x1, 1, Len(x1) / 2)
xx2 = Mid(x1, Len(x1) / 2 + 1, Len(x1) / 2)
xx3 = Mid(x2, 1, Len(x2) / 2)
xx4 = Mid(x2, Len(x2) / 2 + 1, Len(x2) / 2)
abc = False
If (xx1 = xx3) Or (xx1 = xx4) Or (xx2 = xx3) Or (xx2 = xx4) Then
abc = True
End If
End Function
Function def(x1 As String, x2 As String, x3) As Boolean '此函数判断不能有历史重复,与上面函数有区别,上面的函数只判断当前对手,这个是检索历史记录中也不能有重复
xx1 = Mid(x1, 1, Len(x1) / 2) '分拆当前第一个记录为两个部分
xx2 = Mid(x1, Len(x1) / 2 + 1, Len(x1) / 2)
xx3 = Mid(x2, 1, Len(x2) / 2) '分拆当前第二个对手为两个部分
xx4 = Mid(x2, Len(x2) / 2 + 1, Len(x2) / 2)
js1 = 0
def = False
For i = 1 To UBound(x3)
xx5 = Mid(x3(i), 1, InStr(x3(i), "-") - 1) '读取历史记录中的第一个对手
xx6 = Mid(x3(i), InStr(x3(i), "-") + 1, 100) '读取历史记录中的第二个对手
xx7 = Mid(xx5, 1, Len(xx5) / 2) '分拆历史记录第一个对手为两个部分
xx8 = Mid(xx5, Len(xx5) / 2 + 1, Len(xx5) / 2)
xx9 = Mid(xx6, 1, Len(xx6) / 2) '分拆历史记录第二个对手为两个部分
xx10 = Mid(xx7, Len(xx6) / 2 + 1, Len(xx6) / 2)
If (xx1 = xx7 Or xx2 = xx8) And (xx3 = xx9 Or xx4 = xx10) Then '把当前记录与历史记录的两个对手分别做对比,不能有任何等同
def = True
Exit For
End If
Next i
End Function
|
-
|