用VBA根据数据条件输出数据

zzkof

边缘码农 发表于 2024-7-3 17:22
代码中的注释是揣测出来的，不见得正确。

不需要那个单独计算车圈的代码

zzkof

zzkof 发表于 2024-7-4 08:17
在名称一样，单位不一样的情况下，是属于不同产品来计算，可以在计算时合并名称单位，输出时再拆分？
谢 ...

额，这样子件还有下级子件的话逻辑好像又不对了，如果要这样计算的话母件也要加上单位了

边缘码农

zzkof 发表于 2024-7-4 08:33
额，这样子件还有下级子件的话逻辑好像又不对了，如果要这样计算的话母件也要加上单位了

我感觉，要尽量简化。

“在名称一样，单位不一样的情况下，是属于不同产品来计算。”

那就直接改名字。通过名字确认不同的子件。

判断标准越简洁越好。

zzkof

边缘码农 发表于 2024-7-4 09:59
我感觉，要尽量简化。

“在名称一样，单位不一样的情况下，是属于不同产品来计算。”

发现代码有点问题，在没有条件数据的情况下，基础数据会全部被输出到指定位置，虽然没有数量统计

边缘码农

zzkof 发表于 2024-7-4 14:52
发现代码有点问题，在没有条件数据的情况下，基础数据会全部被输出到指定位置，虽然没有数量统计

在这种情况下，想要达到什么效果？

因为没有要加工的数量，不进行任何输出？

zzkof

边缘码农 发表于 2024-7-4 15:17
在这种情况下，想要达到什么效果？

因为没有要加工的数量，不进行任何输出？

是的，没有条件不做输出

边缘码农

zzkof 发表于 2024-7-4 18:03
是的，没有条件不做输出

加几行代码就能解决，先做个判断，条件数据区域没有数据就退出。

边缘码农

zzkof 发表于 2024-7-4 18:03
是的，没有条件不做输出

1. Sub test2()
   
2.     Dim arr, dic(5), i, j, m, key, t, MaxRow
   
3.     ' 循环定义6个字典，编号为0-5
   
4.     For i = 0 To UBound(dic)
   
5.         Set dic(i) = CreateObject("scripting.dictionary")
   
6.     Next
   
7.     With ActiveSheet
   
8.         ' 清除o-W列现有的数据
   
9.         MaxRow = Sheet1.Cells(.Rows.Count, "o").End(xlUp).Row  'o列最后一行
   
10.         If MaxRow > 2 Then
    
11.             .Range(.Cells(3, "o"), .Cells(MaxRow, "W")).ClearContents
    
12.         End If
    
13.         MaxRow = .Cells(.Rows.Count, 6).End(xlUp).Row  '第6列（F列）最后一行
    
14.         If MaxRow <= 2 Then
    
15.             '当第6列（F列，条件区域）只有标题行。没有具体的数据时，退出。
    
16.             End
    
17.         End If
    
18.     End With
    
19.     ' 条件数据部分导入数组中
    
20.     arr = Range("f3:g" & MaxRow).Value
    
21.     ' 条件数据写入字典4：Key=母件名称，Item=母件数量
    
22.     For i = 1 To UBound(arr, 1)
    
23.         If dic(4).Exists(arr(i, 1)) Then
    
24.             ' 条件区域的母件名称存在重复
    
25.             tsxx = "条件区域的母件名称列存在重复，是否继续？" & Chr(10) & Chr(10)
    
26.             tsxx = tsxx & "单击按钮“是”，重复的母件名称数量相加。" & Chr(10) & "单击按钮“否”，退出修改。"
    
27.             If MsgBox(tsxx, vbYesNo + vbQuestion + vbDefaultButton2, "条件数据区域母件名称重复提示") = vbNo Then
    
28.                 ' 单击按钮否，退出修改
    
29.                 End
    
30.             End If
    
31.         End If
    
32.         dic(4)(arr(i, 1)) = arr(i, 2) + dic(4)(arr(i, 1))
    
33.     Next
    
34.     ' 基础数据部分导入数组
    
35.     arr = Range("a3:a" & Cells(Rows.Count, "a").End(xlUp).Row).Resize(, 5).Value
    
36.     ' 重定义数组：10000个成员
    
37.     ReDim brr(1 To 10 ^ 4, 1 To 4)
    
38.     ' 基础数据写入字典2：key=子件名称，Item=1
    
39.     For i = 1 To UBound(arr, 1)
    
40.         dic(2)(arr(i, 2)) = 1
    
41.     Next
    
42.     '根据字典2更改数组arr数组中第5列的值：
    
43.     For i = 1 To UBound(arr, 1)
    
44.         If dic(2).Exists(arr(i, 1)) Then
    
45.             '在字典dic(2)的子件名称中寻找arr数组中的母件名称，并找到
    
46.             arr(i, 5) = 1
    
47.         Else
    
48.             arr(i, 5) = 0
    
49.         End If
    
50.     Next
    
51.     dic(2).RemoveAll '清空字典2
    
52.     ' 根据更新后的arr数组第5列
    
53.     For i = 1 To UBound(arr, 1)
    
54.         If arr(i, 5) = 0 Then
    
55.             ' 此时：子件名称  不出现  在母件名称中
    
56.             ' 字典0：key=母件名称，Item=母件名称+空格1+子件名称
    
57.             dic(0)(arr(i, 1)) = dic(0)(arr(i, 1)) & Space(1) & arr(i, 2)
    
58.             ' 字典1：key=母件名称+子件名称，Item=子件数量
    
59.             dic(1)(arr(i, 1) & arr(i, 2)) = arr(i, 4)
    
60.         Else
    
61.             ' 此时：子件名称  出现  在母件名称中
    
62.             ' 字典2：key=母件名称，Item=字典2中母件名称对应的键值+空格1+子件名称
    
63.             dic(2)(arr(i, 1)) = dic(2)(arr(i, 1)) & Space(1) & arr(i, 2)
    
64.             ' 字典2：key=子件名称，Item=子件数量
    
65.             dic(3)(arr(i, 2)) = arr(i, 4)
    
66.         End If
    
67.         dic(5)(arr(i, 2)) = arr(i, 3)
    
68.     Next
    
69.     ' 经上述处理后：
    
70.     ' 字典0：key=母件名称，Item=该母件需要的子件名称表，空格间隔
    
71.     ' 字典1：key=母件名称&该母件需要的子件，Item=该母件需要的某个子件的数量
    
72.     ' 字典2：key=存在于母件名称中的子件名称（该子件需要子件组成），Item=该子件需要的下级子件名称表，空格间隔
    
73.     ' 字典3：key=存在于母件名称中的子件名称（该子件需要子件组成），Item=该子件需要的数量
    
74.     ' 字典4：key=条件数据区的母件名称，Item=该母件的数量
    
75.     ' 字典5：key=子件名称，Item=该子件的计量单位
    
76.     ' 按照字典0的key数量循环
    
77.     For Each key In dic(0).keys
    
78.         t = Split(dic(0)(key))
    
79.         For i = 1 To UBound(t)
    
80.             If dic(2).Exists(t(i)) Then
    
81.                 ' 递归调用 dfs
    
82.                 Call dfs(dic, key, t(i), brr, m, dic(1)(key & t(i)))
    
83.             Else
    
84.                 m = m + 1
    
85.                 brr(m, 1) = key
    
86.                 brr(m, 2) = t(i)
    
87.                 brr(m, 4) = dic(4)(key) * dic(1)(key & t(i))
    
88.             End If
    
89.         Next
    
90.         m = m + 1
    
91.     Next
    
92.     For i = 1 To UBound(brr)
    
93.         brr(i, 3) = dic(5)(brr(i, 2))
    
94.     Next
    
95.     ReDim drr(1 To m, 1 To 4)
    
96.     For i = 1 To m
    
97.         If brr(i, 4) <> 0 Then
    
98.             For j = 1 To 4
    
99.                 drr(i, j) = brr(i, j)
    
100.             Next
     
101.         End If
     
102.     Next
     
103.     ' t = "车圈"
     
104.     '  If dic(5).Exists(t) Then [g6] = t & ":" & dic(5)(t) Else [g6] = Empty
     
105.     [o3].Resize(UBound(drr, 1), UBound(drr, 2)) = drr
     
106.     dic(2).RemoveAll '清空字典2
     
107.     ' 汇总brr数组中子件名称的数量
     
108.     For i = 1 To UBound(brr)
     
109.         dic(2)(brr(i, 2)) = dic(2)(brr(i, 2)) + brr(i, 4)
     
110.     Next
     
111.     ReDim crr(1 To dic(2).Count, 1 To 3)
     
112.     i = 1
     
113.     For Each key In dic(2).keys
     
114.         If key <> "" Then
     
115.             crr(i, 1) = key
     
116.             crr(i, 2) = dic(5)(crr(i, 1))
     
117.             crr(i, 3) = dic(2)(key)
     
118.             i = i + 1
     
119.         End If
     
120.     Next
     
121.     [t3].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
     
122. End Sub
     

复制代码