根据条件自动增加行并填上相应信息

dut01

求助各位大大：
甲方从乙方哪里购买水果，签订了购买合同，清单里面没有具体的产地，等乙方送完货后把发货清单（里面产品顺序都是混乱的）给了甲方，甲方按照合同清单的顺序进行清点，发现苹果是三个产地，之后根据产地把合同清单中的苹果按照发货清单中的苹果的不同产地进行分解，然后形成了库存清单。相见附件，谢谢！

ykcbf1100

表2和表3数据一样啊，你排序一下就好了。

半百

3190496160

Sub 清单()
Dim ar As Variant, br As Variant
Dim arr()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 4 Then MsgBox "购买合同为空！": End
    ar = Range("a3:b" & r)
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs < 4 Then MsgBox "发货清单为空！": End
    br = Range("d3:f" & rs)
    ReDim arr(1 To UBound(br), 1 To UBound(br, 2))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            For s = 2 To UBound(br)
                If Trim(br(s, 1)) = Trim(ar(i, 1)) Then
                    n = n + 1
                    For j = 1 To UBound(br, 2)
                        arr(n, j) = br(s, j)
                    Next j
                End If
            Next s
        End If
    Next i
    If n = "" Then End
    ws = .Cells(Rows.Count, 9).End(xlUp).Row
    If ws > 3 Then .Range("i4:k" & ws) = Empty
    .[i4].Resize(n, UBound(arr, 2)) = arr
End With
MsgBox "ok!"
End Sub

3190496160

工作簿2.rar (17.14 KB, 下载次数: 3)

2023-2-7 17:26 上传

点击文件名下载附件

3190496160

无非就是自定义排序而已，自己看看吧

半百

或者添加一个辅助列，第4行的单元格输入公式=MATCH(D4,$D$4:$D$12,)+COUNTIF($D$4:D4,D4)%，下拉后按此列为关键字排序。

dut01

3190496160 发表于 2023-2-7 17:27
无非就是自定义排序而已，自己看看吧

老师，不是排序。是要根据表2，对表1进行添加行，分解和查询操作，最后变成表3的形式。可能语言表达的不是很清楚，我这边做了一个逻辑图，并把每种情况都重新在表中显示出来，比较复杂，请老师看看能否实现。

3190496160

dut01 发表于 2023-2-8 10:38
老师，不是排序。是要根据表2，对表1进行添加行，分解和查询操作，最后变成表3的形式。可能语言表达的不 ...

论坛是做义务的，没有人愿意在一个问题上反复折腾的，所以，一开始就要上传自己真实的问题，把自己的意图表述清楚，模拟结果要包括会出现额所有情况，
你在一楼上传的附件，模拟的结果，显然是在误导帮你的人

dut01

3190496160 发表于 2023-2-8 11:23
论坛是做义务的，没有人愿意在一个问题上反复折腾的，所以，一开始就要上传自己真实的问题，把自己的意图 ...

非常抱歉，下次注意！