vba快速配档

zuiaijiushi

跟你前后脚提的问题，这几天自学了下，写了个，你看是不是你要的效果，你要的“一键”在做在表格里了

zuiaijiushi

看了下，忘了写清理旧数据的码了，每次配对前自己删一下旧数据，保留表头

uqfyplj

可以现把所有数据提取胡来进行对比和加减，在用配对进行分类。

简七

sql 语言可以一试

zjh919818

zuiaijiushi 发表于 2021-3-13 14:32
跟你前后脚提的问题，这几天自学了下，写了个，你看是不是你要的效果，你要的“一键”在做在表格里了

感觉不错  我回去用用~
感谢大佬

zjh919818

zuiaijiushi 发表于 2021-3-13 14:32
跟你前后脚提的问题，这几天自学了下，写了个，你看是不是你要的效果，你要的“一键”在做在表格里了

大佬
你这个公式有个问题
就是对于C零件来说，他会进行后者对前者的覆盖，
比如A1零件和B零件的配档是B12,B13，A1零件和C零件的配档是C5,C6,C7
那么应该排序出来的是
A1;B12;C5
A1;B12;C6
A1;B12;C7
A1;B13;C5
A1;B13;C6
A1;B13;C7
但是现在实际情况是
A1;B12;C7
A1;B13;C7

这是一个排列组合问题

然后又有一个新的问题
怎么确定最大选配率，
比如我A1零件选用B12后，A8就不能选用B12了
同样的，A1选用C8后，A2就不能选用C8了
如何能做到最大程度的选用零件呢？
即我需要输出两种结果
第一种结果是全部配档情况
第二种是最大配档情况

我现在根据您的程序做了一点优化，可以直接在表格进行自己修订大小参数，以及清理之前配档。
后续的操作，请大佬帮忙想个办法·····
万分感谢
如果需要讨论
QQ 947142138
WX monkey919818
谢谢各位大佬

zjh919818

我优化了一下程序，可以表现出来了
Sub shishi()
Worksheets(1).[l2:T65536].ClearContents
Dim HIGHMAX, HIGHMIN, DEEPMAX, DEEPMIN
HIGHMAX = Range("K15")
HIGHMIN = Range("K16")
DEEPMAX = Range("K18")
DEEPMIN = Range("K19")
Dim I, J, K, L
Dim ARR, BRR, CRR, drr
ARR = Range("a1:c" & Range("a65536").End(xlUp).Row)
BRR = Range("e1:f" & Range("e65536").End(xlUp).Row)
CRR = Range("h1:i" & Range("h65536").End(xlUp).Row)
For I = 2 To UBound(ARR)
    For J = 2 To UBound(BRR)
        For K = 2 To UBound(CRR)
            If BRR(J, 2) - ARR(I, 2) >= HIGHMIN And BRR(J, 2) - ARR(I, 2) <= HIGHMAX And CRR(K, 2) - ARR(I, 3) >= DEEPMIN And CRR(K, 2) - ARR(I, 3) <= DEEPMAX Then
                   Range("a" & I & ":" & "c" & I).Copy Range("l" & Range("l65536").End(xlUp).Row + 1)
                   Range("e" & J & ":" & "f" & J).Copy Range("o" & Range("l65536").End(xlUp).Row)
                   Range("h" & K & ":" & "i" & K).Copy Range("q" & Range("l65536").End(xlUp).Row)
                   Range("S" & Range("l65536").End(xlUp).Row) = Range("P" & Range("l65536").End(xlUp).Row) - Range("M" & Range("l65536").End(xlUp).Row)
                   Range("T" & Range("l65536").End(xlUp).Row) = Range("R" & Range("l65536").End(xlUp).Row) - Range("N" & Range("l65536").End(xlUp).Row)
                End If
        Next
    Next
Next
End Sub

1. Sub shishi()
   
2. Worksheets(1).[l2:T65536].ClearContents
   
3. Dim HIGHMAX, HIGHMIN, DEEPMAX, DEEPMIN
   
4. HIGHMAX = Range("K15")
   
5. HIGHMIN = Range("K16")
   
6. DEEPMAX = Range("K18")
   
7. DEEPMIN = Range("K19")
   
8. Dim I, J, K, L
   
9. Dim ARR, BRR, CRR, drr
   
10. ARR = Range("a1:c" & Range("a65536").End(xlUp).Row)
    
11. BRR = Range("e1:f" & Range("e65536").End(xlUp).Row)
    
12. CRR = Range("h1:i" & Range("h65536").End(xlUp).Row)
    
13. For I = 2 To UBound(ARR)
    
14.     For J = 2 To UBound(BRR)
    
15.         For K = 2 To UBound(CRR)
    
16.             If BRR(J, 2) - ARR(I, 2) >= HIGHMIN And BRR(J, 2) - ARR(I, 2) <= HIGHMAX And CRR(K, 2) - ARR(I, 3) >= DEEPMIN And CRR(K, 2) - ARR(I, 3) <= DEEPMAX Then
    
17.                    Range("a" & I & ":" & "c" & I).Copy Range("l" & Range("l65536").End(xlUp).Row + 1)
    
18.                    Range("e" & J & ":" & "f" & J).Copy Range("o" & Range("l65536").End(xlUp).Row)
    
19.                    Range("h" & K & ":" & "i" & K).Copy Range("q" & Range("l65536").End(xlUp).Row)
    
20.                    Range("S" & Range("l65536").End(xlUp).Row) = Range("P" & Range("l65536").End(xlUp).Row) - Range("M" & Range("l65536").End(xlUp).Row)
    
21.                    Range("T" & Range("l65536").End(xlUp).Row) = Range("R" & Range("l65536").End(xlUp).Row) - Range("N" & Range("l65536").End(xlUp).Row)
    
22.                 End If
    
23.         Next
    
24.     Next
    
25. Next
    
26. End Sub
    

复制代码

zuiaijiushi

zjh919818 发表于 2021-3-21 18:24
大佬
你这个公式有个问题
就是对于C零件来说，他会进行后者对前者的覆盖，

你的问题描述不太懂，按我的理解，你说的“全部陪档”，你自己写的应该已经搞定了吧？
第二种情况，意思不能重复，一对一，是吧？那你在每次循环都加个条件，限制下一次循环应该就行了吧？比如配对条件除了数值，还加一个单元格填色，限制为无填充，循环找到第一个结果，复制a1，b1到结果之后再给b1填个色，下次循环到b1发现有填充就会继续向下寻找了，所有循环结束再写个去除填充的码，这样的思路可行吗？

zjh919818

zuiaijiushi 发表于 2021-3-22 14:55
你的问题描述不太懂，按我的理解，你说的“全部陪档”，你自己写的应该已经搞定了吧？
第二种情况，意思 ...

大概是这个意思，但是现在循环我不太会做
我需要如下的循环
        Y1        Y2        Y3
X1        *        *        *
X2        *        *        *
X3        *        *        *

第一组
X1Y1
X2Y1
X3Y1
第二组
X1Y1
X2Y1
X3Y2
第三组
X1Y1
X2Y1
X3Y3
第四组
X1Y1
X2Y2
X3Y1
第5组
X1Y1
X2Y2
X3Y2
第6组
X1Y1
X2Y2
X3Y3
第7组
X1Y1
X2Y3
X3Y1
等等，
就是说每次每行只能选一个，行数有N行，每一列有ARR(N)个
怎么去写这个循环？