求不同行的快速算法

xueok

feto 发表于 2021-11-18 19:26
结果是对的，不过：
按循环看次数并没有少，但结果只能求得一个;有一种情况没有考虑，就是最小值有多个 ...

是的，自己感觉算法还是复杂

zopey

1. Sub pey_t()
   
2.     Dim ar, k0, br, jg
   
3.     k0 = 5 ''参数1
   
4.     ar = [b1].Resize(k0, k0)
   
5.    
   
6.     ReDim br(1 To k0, 0 To k0)
   
7.     For i = 1 To k0
   
8.         For j = 1 To k0
   
9.         If ar(i, j) = "" Then
   
10.            br(i, 0) = br(i, 0) + 1
    
11.            br(i, br(i, 0)) = j
    
12.         End If
    
13.         Next
    
14.     Next
    
15.    
    
16.     ReDim jg(1 To k0, 0 To 1)
    
17.     i = 1: t = 1 ''i=行号
    
18.     Do
    
19.         If i = 0 Then MsgBox "无解": Exit Sub
    
20.         If i > k0 Then Exit Do
    
21. 
    
22.             For j = jg(i, 0) + 1 To br(i, 0)
    
23.                 If jg(br(i, j), 1) = 0 Then
    
24.                    jg(br(i, j), 1) = 1
    
25.                    jg(i, 0) = j
    
26.                    t = 1
    
27.                    Exit For
    
28.                 End If
    
29.             Next
    
30.             
    
31.             If j > br(i, 0) Then
    
32.                t = -1
    
33.                jg(i, 0) = 0
    
34. 
    
35.                   temp = br(i - 1, jg(i - 1, 0))
    
36.                   jg(temp, 1) = 0
    
37.             End If
    
38. 
    
39.         i = i + t
    
40.     Loop
    
41.    
    
42.    For i = 1 To k0
    
43.        jg(i, 0) = br(i, jg(i, 0))
    
44.    Next
    
45.    [a1].Resize(k0, 1) = jg
    
46. End Sub
    

复制代码

zopey

数据B列往后 ，结果在A列

不重复行列.rar (12.82 KB, 下载次数: 11)

2021-11-20 10:54 上传

点击文件名下载附件

xueok

zopey 发表于 2021-11-20 10:54
数据B列往后 ，结果在A列

这个程序真是惊艳，谢谢zopey，我得消化一下，能否在程序中写下注释，理解起来方便些。br记录空位置与数量，jg先保存序号，最后还原成行号，总体采用回溯。只是为什么要将行列换过来呢？不换不好写代码？

zopey

xueok 发表于 2021-11-20 22:42
这个程序真是惊艳，谢谢zopey，我得消化一下，能否在程序中写下注释，理解起来方便些。br记录空位置与数 ...

按你想法，可以对第2段 略作修改，行列转置

ReDim br(1 To k0, 0 To k0)
for j=1 to k0
for i=1 to k0
     if  xxx then br(j,0)=br(j,0)+1

yjh_27

参见28L附件4
n取m 自定义函数 随机 组合 排列 分组 分配
https://club.excelhome.net/thread-1526867-1-1.html
(出处: ExcelHome技术论坛)

笨鸟飞不高

求不同行的快速算法.zip (16.15 KB, 下载次数: 1)

2022-4-18 13:39 上传

点击文件名下载附件

练习！