有什么方式将替代关系自动填充到新机种中

三联单是是是

工作中一直有这样一个问题在困扰我，就是在资料库中一颗物料有几个替代品，但在新机种初期并没有将对应当替代关系建立好，有什么方式将替代关系自动填充到新机种中，请高手帮忙！！！ 序号 替代关系 料号-资料库 描述 1 　 C1122645M42TU1 CAP MLCC,22uF,6.3V,20%,0805/SMT,X5R,RoHS COMPLIANCE 　 * C1122645M42 CAP MLCC,22uF,6.3V,20%,0805/SMT,X5R,RoHS COMPLIANCE 　 ** C1122645M42SL1 MLCC 22UF/6.3V (0805) X5R 20% 2 　 C1110635K42TU1 CAP MLCC,10uF,6.3V,±20%,0603/SMT,X5R,RoHS COMPLIANCE 3 　 C111032XK62MR1 CAP MLCC,0.01uF,16V,10%,0402/SMT,X7R,RoHS COMPLIANCE 　 * C111032XK62TD1 CAP MLCC，0.01uF，16V，10%，0402/SMT，X7R，RoHS COMPLIANCE 　 ** C111032XK62TU1 CAP MLCC，0.01uF，16V，10%，0402/SMT，X7R，RoHS COMPLIANCE 　 *** C111032XKA2 CAP MLCC,0.01uF,50V,10%,0402/SMT,X7R,RoHS COMPLIANCE 序号 替代关系 料号-新机种 描述 1 　 C1122645M42TU1 CAP MLCC,22uF,6.3V,20%,0805/SMT,X5R,RoHS COMPLIANCE 2 　 C1110635K42TU1 CAP MLCC,10uF,6.3V,±20%,0603/SMT,X5R,RoHS COMPLIANCE 3 　 C111032XK62TU1 CAP MLCC,0.01uF,16V,10%,0402/SMT,X7R,RoHS COMPLIANCE

三联单是是是

上传表单，请高手帮忙

KCFONG

Not understand ???
Give real example

三联单是是是

重新做一个详细的实列，请帮忙看下，谢谢。

chxw68

1. Sub test()
   
2.   Dim d As Object
   
3.   'Dim d As New Dictionary
   
4.   Dim i%, r%
   
5.   Dim arr
   
6.   Set d = CreateObject("scripting.dictionary")
   
7.   arr = Worksheets("替代关系表").Range("a2").CurrentRegion
   
8.   For i = 2 To UBound(arr)
   
9.     If Len(arr(i, 2)) = 0 Then
   
10.       d(arr(i, 3)) = arr(i, 3)
    
11.       xm = arr(i, 3)
    
12.     Else
    
13.       d(xm) = d(xm) & "+" & arr(i, 3)
    
14.     End If
    
15.   Next
    
16.   tt = d.Items
    
17.   For i = 0 To UBound(tt)
    
18.     xm = Split(tt(i), "+")
    
19.     If UBound(xm) > 0 Then
    
20.       For j = 0 To UBound(xm)
    
21.         d(xm(j)) = tt(i)
    
22.       Next
    
23.     End If
    
24.   Next
    
25.   
    
26.   Worksheets("想实现功能").Select
    
27.   r = Cells(Rows.Count, 3).End(xlUp).Row
    
28.   For i = r To 2 Step -1
    
29.     xm = Cells(i, 3)
    
30.     If d.Exists(xm) Then
    
31.       xx = Split(d(xm), "+")
    
32.       If UBound(xx) > 0 Then
    
33.         Rows(i + 1 & ":" & i + UBound(xx)).Insert
    
34.         Cells(i, 3).Resize(UBound(xx) + 1, 1) = Application.Transpose(xx)
    
35.       End If
    
36.     End If
    
37.   Next
    
38.   Set d = Nothing
    
39. End Sub

复制代码

chxw68

你测试一下。

三联单是是是

chxw68 发表于 2013-12-4 10:01
你测试一下。

非常感谢，高手就是牛。

如是能将“*”也一并加入就更好了，不然我还得用IF函数去判断每一行是否是替代关系，再在替代料的前面加上“*”，“**”。

chxw68

你试试看。

三联单是是是

chxw68 发表于 2013-12-4 11:09
你试试看。

谢谢大师的帮忙，己完全满足我工作需求了。

yoyodw

请教一下，这个是怎么实现的？如果我想增加替代料那一整行呢？颜色呢？