GBKEE

回復 5# v03586
一步一步來

1. Option Explicit
   
2. Const xNote = "HQ-5F,HQ5F,HQ-2F,HQ2F,AT7F,AT6F,CSP,ENG"
   
3. Dim wB(1 To 2) As Workbook, xDevice As String, xDen As String
   
4. Sub Ex()
   
5.     Dim Pkg As String, Rng(1 To 2) As Range, Rng_Addres As String
   
6.     Dim Ar, xMsg As Boolean, E As Variant
   
7.     Set wB(1) = Workbooks("開機數計算程式xls.xls")
   
8.     Set wB(2) = Workbooks("ONHAND2HR_FMC_PP__112015181315.xls")
   
9.     Ar = Split(xNote, ",")
   
10.     With Workbooks(2).Sheets(1)
    
11.         Set Rng(1) = .Cells.Find("PKG Type :", LookIn:=xlValues, LOOKAT:=xlWhole)
    
12.         Rng_Addres = Rng(1).Address
    
13.         Do
    
14.            Pkg = Rng(1).Cells(1, 4)
    
15.             Set Rng(2) = Rng(1).Offset(1)
    
16.             Do
    
17.                 xMsg = True
    
18.                 If Rng(2) <> "" Then
    
19.                     For Each E In Ar
    
20.                         If InStr(Rng(2).Cells(1, 3), E) Then
    
21.                             xMsg = False
    
22.                             Exit For
    
23.                         End If
    
24.                     Next
    
25.                     If xMsg And InStr(Rng(2)(1, 4), "G") Then
    
26.                         Ex_Device Rng(2)(1, 4)
    
27.                     End If
    
28.                 End If
    
29.                 Set Rng(2) = Rng(2).Offset(1)
    
30.             Loop Until Rng(2).Text = "SubTotal:"
    
31.             
    
32.             Set Rng(1) = .Cells.Find(Rng(1).Text, Rng(1))
    
33.             Rng(1).Interior.Color = vbYellow
    
34.         Loop Until Rng_Addres = Rng(1).Address
    
35.        ' .Close False
    
36.        MsgBox "OK"
    
37.     End With
    
38. End Sub
    
39. Sub Ex_Device(S As String)
    
40.     Dim i As Integer, xRng As Range
    
41.     Debug.Print vbLf & S & " ---"   'VBA  即時算視窗 顯示
    
42.     i = InStrRev(S, "G") - 1
    
43.     Do While IsNumeric(Mid(S, i, 1))
    
44.         i = i - 1
    
45.     Loop
    
46.     S = Mid(S, i + 1)
    
47.     i = InStr(S, "-")
    
48.     If i > 0 Then
    
49.         S = Replace(Mid(S, 1, i - 1), "GG", "G")
    
50.     Else
    
51.         S = Replace(Mid(S, 1), "GG", "G")
    
52.     End If
    
53.     i = InStr(S, "G")
    
54.     For i = InStr(S, "G") + 1 To Len(S)
    
55.         If Mid(S, i, 1) Like "[0-9]" Then
    
56.             S = Mid(S, 1, i)
    
57.             Exit For
    
58.         End If
    
59.     Next
    
60.     xDevice = S
    
61.     xDen = Val(S) & "G*" & Mid(S, i, 1)
    
62.     Set xRng = wB(1).Sheets("Layer").Cells.Find(xDevice, LookIn:=xlValues)
    
63.     If xRng Is Nothing Then
    
64.         Debug.Print "找不到 " & xDevice & vbTab & xDen
    
65.     Else
    
66.        Debug.Print "找到 " & xDevice & vbTab & xDen & " 在 " & xRng.Address(, , , 1)
    
67.     End If
    
68. End Sub

複製代碼