|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
参与一下。。。
- Sub ykcbf() '//2024.4.29
- Application.ScreenUpdating = False
- Dim fns As New Collection
- p = ThisWorkbook.Path & ""
- Set d = CreateObject("Scripting.Dictionary")
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set sh = ThisWorkbook.Sheets("FQC data entry")
- st = sh.[b5].Value
- If st = Empty Then Exit Sub
- a = [{"All RMA","All NSR"}]
- b = [{"Total RMAs list ","NSR List"}]
- aa = [{"RMA#","日期","客户","产品型号","坏因代码","不符合描述(中文)","状态"}]
- bb = [{"RMA No","日期","客户","产品型号","Failure code reported","不符合描述(中文)","status"}]
- aa1 = [{"NSR编号","开单日期","产品型号","拉别&组","坏因代码","不符合描述(中文)","状态"}]
- bb1 = [{"编号","开单日期","产品型号","拉别&组","坏因代码","不符合描述(中文)","状态"}]
- ReDim brr(1 To 1000, 1 To UBound(aa) + 1)
- ReDim crr(1 To 1000, 1 To UBound(aa1) + 1)
- For x = 1 To UBound(a)
- d(a(x)) = b(x)
- Next
- For x = 1 To UBound(aa)
- d(aa(x)) = bb(x)
- Next
- For x = 1 To UBound(aa1)
- d(aa1(x)) = bb1(x)
- Next
- Set ff = fso.GetFolder(p)
- getFiles ff, fns, fso
- On Error Resume Next
- For Each f In fns
- bm = d(f(1))
- Set wb = Workbooks.Open(f(0), 0)
- Set sht = wb.Sheets(bm)
- With sht
- arr = .UsedRange
- c = .Rows(2).Find("产品型号", , , , , 1).Column
- End With
- wb.Close False
- m = 0: n = 0
- If f(1) = a(1) Then
- For i = 3 To UBound(arr)
- If InStr(arr(i, c), st) Then
- m = m + 1
- For x = 1 To UBound(aa)
- For j = 1 To UBound(arr, 2)
- If arr(2, j) = bb(x) Then
- brr(m, x) = arr(i, j)
- End If
- Next
- Next
- End If
- Next
- Else
- For i = 3 To UBound(arr)
- If InStr(arr(i, c), st) Then
- n = n + 1
- For x = 1 To UBound(aa1)
- For j = 1 To UBound(arr, 2)
- If arr(2, j) = bb1(x) Then
- crr(n, x) = arr(i, j)
- End If
- Next
- Next
- End If
- Next
- End If
- Next
- With sh
- .[a12:z1000] = ""
- .[a12].Resize(m, UBound(aa)) = brr
- .[a12].Resize(m, UBound(aa)).Borders.LineStyle = 1
- .[i12].Resize(n, UBound(aa1)) = crr
- .[i12].Resize(n, UBound(aa1)).Borders.LineStyle = 1
- End With
- Set d = Nothing
- MsgBox "OK!"
- End Sub
复制代码
|
|