两个矩阵所有组合相加，是否用字典(Dictionary)最方便？

micch

FrogXiaoQing 发表于 2023-5-28 23:52
谢谢前辈的代码。同上，有一个问题。如果我把表一的A改为D，程序就不能显示所有不为零的组合了。即显示不 ...

明白了，不过代码临时写完就完了，也没保存


截图中框中的区域，用d.exists判断是否存在，允许不一样的保留，所以删除掉这个if和对应的end if  就行了

笨鸟飞不高

FrogXiaoQing 发表于 2023-5-28 23:55
谢谢回复。但我一打开你的文件Excel就自动删除了你的代码。可以帮忙把代码做成txt文件吗？再次感谢。

code.zip (566 Bytes, 下载次数: 1)

2023-5-29 11:39 上传

点击文件名下载附件

代码供参考！


不过也提醒一下楼主，有时间看一下这个贴：
https://club.excelhome.net/thread-682160-1-1.html

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, k%, m%, n%, arr, brr, crr, drr
   
3.     Dim rng As Range, sht As Worksheet, wbk As Workbook
   
4.     Dim dic As Object, key, keys, items
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     arr = Range("A1").CurrentRegion.Value
   
7.     brr = Range("A7").CurrentRegion.Value
   
8.     For i = 2 To UBound(arr)
   
9.         For j = 2 To UBound(arr, 2)
   
10.             key = arr(i, 1) & "-" & arr(1, j)
    
11.             dic(key) = dic(key) + arr(i, j)
    
12.         Next
    
13.     Next
    
14.     For j = 2 To UBound(brr, 2)
    
15.         For i = 2 To UBound(brr)
    
16.             key = brr(1, j) & "-" & brr(i, 1)
    
17.             dic(key) = dic(key) + brr(i, j)
    
18.         Next
    
19.     Next
    
20.     keys = dic.keys
    
21.     items = dic.items
    
22.     ReDim crr(1 To 100, 1 To 2)
    
23.     For i = LBound(keys) To UBound(keys)
    
24.         If items(i) <> 0 Then
    
25.             k = k + 1
    
26.             crr(k, 1) = keys(i)
    
27.             crr(k, 2) = items(i)
    
28.         End If
    
29.     Next
    
30.     Range("M2").Resize(k, 2) = crr
    
31. End Sub
    

复制代码

lushang2018

FrogXiaoQing

lushang2018 发表于 2023-5-29 15:45

感谢大神，完美解决！！