楼主
liuguansky |
Q： 要求：
1、按A列的内容，分别从工作表“BOM”中H列找着对应项，并将对应项的相应A列的SAP编码返回到当前表的F列上
2、工作表“BOM”中如果有空行的，可以做删除处理
A:用如下代码可以实现：- Sub justtest()
- Dim Arr, k&, i&, d, ArrTmp, StrTmp$, j%, ArrResult() As String
- Set d = CreateObject("scripting.dictionary") '创建字典项目
- With Sheets("BOM") '对BOM表进行处理
- k = .Cells(.Rows.Count, 1).End(3).Row '取最后行号
- Arr = .Range("a1:h" & k).Value '赋值数据给数组
- For i = 2 To k '循环数组
- If Len(Trim(Arr(i, 8))) Then '如果非空
- ArrTmp = Split(Arr(i, 8), ",") '以逗号分隔
- For j = LBound(ArrTmp) To UBound(ArrTmp) '循环分隔内容
- If d.Exists(ArrTmp(j)) Then '如果字典项目存在
- If Not d(ArrTmp(j)).Exists(Arr(i, 1)) Then '如果子字典项目不存在，就进行添加项目
- '对子字典项目去重
- d(ArrTmp(j)).Add Arr(i, 1), ""
- End If
- Else: d.Add ArrTmp(j), "" '如果字典项目不存在，就添加项目
- Set d(ArrTmp(j)) = CreateObject("scripting.dictionary") '并创建子字典
- d(ArrTmp(j)).Add Arr(i, 1), "" '添加子字典项目
- End If
- Next j
- Else: StrTmp = StrTmp & ",a" & i '如果为空，则合并行号
- End If
- Next i
- If StrTmp <> "" Then .Range(Mid(StrTmp, 2)).EntireRow.Delete '如果有空值行，刚进行整行删除。
- End With
- With Sheets("place_txt") '获取结果返回表
- k = .Cells(.Rows.Count, 1).End(3).Row
- Arr = .Cells(1, 1).Resize(k, 1).Value '赋值待判断区域数据入数组
- ReDim ArrResult(1 To k, 1 To 1) '重定义结果数组
- For i = 1 To k '循环判断数据数组
- If d.Exists(Arr(i, 1)) Then '如果存在，则
- ArrResult(i, 1) = Join(d(Arr(i, 1)).Keys, ",") '返回编码
- End If
- Next i
- .Range("f:f").Clear
- .Range("f1").Resize(k, 1) = ArrResult '返回结果数组
- ' .Range("f:f").NumberFormatLocal = "@"
- MsgBox "处理完毕，相关数据已引入", vbOKOnly '友情提示操作完成
- End With
- Set d = Nothing '清空字典对象
- End Sub
 桌面.rar
|