关于借贷成组配对

阿煮

同一类型下，借贷金额一样的配一组，就在F列标记“成对”，比如3和4 ，5和7行，余下的只能“单着”。我用的字典嵌套，在D和E列标记是这个类型这个金额的第几个。结果是出来了。但是感觉太啰嗦了。如果数据很多，感觉效率也不高的。请问这个是可以简单点思路来吗，请指点下，谢谢~

longwin

Sub test()
zh = [a2].End(xlDown).Row
arr = Range("B3:B" & zh)
brr = Range("C3:C" & zh)
ReDim crr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    For j = 1 To UBound(brr)
        If arr(i, 1) <> "" And brr(j, 1) = arr(i, 1) And crr(j, 1) = "" Then
            crr(i, 1) = "成对"
            crr(j, 1) = "成对"
            Exit For
        End If
    Next
Next
For i = 1 To UBound(crr)
    If crr(i, 1) = "" Then crr(i, 1) = "单着"
Next
[G3].Resize(UBound(crr), 1) = crr
End Sub

longwin

longwin

供参考。。。。。。。

阿煮

longwin 发表于 2024-10-25 21:31
供参考。。。。。。。

非常感谢，但是有个问题，如果数据好大，比如几十万行，是否运行效率不高。但是如果数据少情况。还是非常简洁的

笨鸟飞不高

准提部林

借/貸 金額配對...by.准提部林
Xl0000299.rar (16.33 KB, 下载次数: 7)

2024-10-26 12:02 上传

点击文件名下载附件

阿煮

笨鸟飞不高 发表于 2024-10-26 10:57

感谢

Qs18

1. Sub qs()
   
2. With Sheet1
   
3.     arr = .Range("a3:c" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     For i = 1 To UBound(arr)
   
6.         If Len(arr(i, 2)) > 0 Then
   
7.             For j = 1 To UBound(arr)
   
8.                 If Len(arr(j, 3)) > 0 Then
   
9.                     If brr(j, 1) <> "成对" Then
   
10.                         If arr(i, 1) & arr(i, 2) = arr(j, 1) & arr(j, 3) Then
    
11.                             brr(i, 1) = "成对": brr(j, 1) = "成对"
    
12.                             Exit For
    
13.                         Else
    
14.                             brr(i, 1) = "单看"
    
15.                         End If
    
16.                     End If
    
17.                 End If
    
18.             Next j
    
19.         End If
    
20.     Next i
    
21.     For i = 1 To UBound(brr)
    
22.         If brr(i, 1) = "" Then brr(i, 1) = "单看"
    
23.     Next
    
24.     .Range("f3").Resize(UBound(brr), 1) = brr
    
25. End With
    
26. End Sub

复制代码

Qs18

试试...........