楼主
liuguansky |
Q:如何依另一个工作簿中的三个工作表中的数据进行工程号查找，并拆分返回成数值X数值的形式，同时要兼容大小写，空格有无的情况？
A：
用如下代码可以实现：
- Sub justtest()
- Dim dic, arr, sht As Worksheet, i&, j&, m&, arr1, arr2, arrt(), n1&, n2&
- Set dic = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- Workbooks.Open (ThisWorkbook.Path & "/印刷工程單記錄.xls")
- With ActiveWorkbook
- For i = 6 To 8
- Set sht = .Worksheets(i)
- arr = sht.Cells(1, 2).Resize(Cells(sht.Rows.Count, 2).End(3).Row, 15).Value
- For j = 2 To UBound(arr, 1)
- If Not dic.exists(arr(j, 1)) Then
- dic.Add arr(j, 1), arr(j, 2) & vbTab & arr(j, 15)
- End If
- Next j
- Next i
- .Close False
- End With
- With Sheet3
- m = .Cells(.Rows.Count, 3).End(3).Row - 4
- .Range("d5:m" & m + 4).ClearContents
- arr = Cells(5, 3).Resize(m, 1).Value
- ReDim arrt(1 To m, 1 To 5)
- For i = 1 To UBound(arr, 1)
- If arr(i, 1) <> "" And dic.exists(arr(i, 1)) Then
- arrt(i, 3) = "×"
- arr1 = Split(dic(arr(i, 1)), vbTab)
- arrt(i, 1) = arr1(0)
- n1 = InStr(1, arr1(1), "x")
- n2 = InStr(1, arr1(1), "X")
- If n1 + n2 > 0 Then
- arr2 = Split(arr1(1), IIf(n1 > 0, "x", "X"))
- arrt(i, 2) = arr2(0)
- arrt(i, 4) = Split(Trim(arr2(1)))(0)
- arrt(i, 5) = Application.WorksheetFunction.Round(Val(arrt(i, 2)) * Val(arrt(i, 4)), 2)
- Else: arrt(i, 2) = "": arrt(i, 4) = "": arrt(i, 5) = ""
- End If
- Else
- For j = 1 To 5
- arrt(i, j) = ""
- Next j
- End If
- Next i
- .Cells(5, 4).Resize(m, 1) = Application.Index(arrt, , 1)
- For i = 1 To 4
- .Cells(5, "j").Offset(0, i - 1).Resize(m, 1) = Application.Index(arrt, , i + 1)
- Next i
- End With
- Application.ScreenUpdating = True
- Set dic = Nothing
- End Sub
|