| ©«¤l5923 ¥DÃD13 ºëµØ1 ¿n¤À5986 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»Office 2010 ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥xÆW°ò¶© µù¥U®É¶¡2010-5-1 ³Ì«áµn¿ý2022-1-23 
         
 | 
                
| ¥»©«³Ì«á¥Ñ GBKEE ©ó 2015-11-28 05:48 ½s¿è 
 ¦^´_ 5# v03586
 ¤@¨B¤@¨B¨Ó
 ½Æ»s¥N½XOption Explicit
Const xNote = "HQ-5F,HQ5F,HQ-2F,HQ2F,AT7F,AT6F,CSP,ENG"
Dim wB(1 To 2) As Workbook, xDevice As String, xDen As String
Sub Ex()
    Dim Pkg As String, Rng(1 To 2) As Range, Rng_Addres As String
    Dim Ar, xMsg As Boolean, E As Variant
    Set wB(1) = Workbooks("¶}¾÷¼Æpºâµ{¦¡xls.xls")
    Set wB(2) = Workbooks("ONHAND2HR_FMC_PP__112015181315.xls")
    Ar = Split(xNote, ",")
    With Workbooks(2).Sheets(1)
        Set Rng(1) = .Cells.Find("PKG Type :", LookIn:=xlValues, LOOKAT:=xlWhole)
        Rng_Addres = Rng(1).Address
        Do
           Pkg = Rng(1).Cells(1, 4)
            Set Rng(2) = Rng(1).Offset(1)
            Do
                xMsg = True
                If Rng(2) <> "" Then
                    For Each E In Ar
                        If InStr(Rng(2).Cells(1, 3), E) Then
                            xMsg = False
                            Exit For
                        End If
                    Next
                    If xMsg And InStr(Rng(2)(1, 4), "G") Then
                        Ex_Device Rng(2)(1, 4)
                    End If
                End If
                Set Rng(2) = Rng(2).Offset(1)
            Loop Until Rng(2).Text = "SubTotal:"
            
            Set Rng(1) = .Cells.Find(Rng(1).Text, Rng(1))
            Rng(1).Interior.Color = vbYellow
        Loop Until Rng_Addres = Rng(1).Address
       ' .Close False
       MsgBox "OK"
    End With
End Sub
Sub Ex_Device(S As String)
    Dim i As Integer, xRng As Range
    Debug.Print vbLf & S & " ---"   'VBA  §Y®Éºâµøµ¡ Åã¥Ü
    i = InStrRev(S, "G") - 1
    Do While IsNumeric(Mid(S, i, 1))
        i = i - 1
    Loop
    S = Mid(S, i + 1)
    i = InStr(S, "-")
    If i > 0 Then
        S = Replace(Mid(S, 1, i - 1), "GG", "G")
    Else
        S = Replace(Mid(S, 1), "GG", "G")
    End If
    i = InStr(S, "G")
    For i = InStr(S, "G") + 1 To Len(S)
        If Mid(S, i, 1) Like "[0-9]" Then
            S = Mid(S, 1, i)
            Exit For
        End If
    Next
    xDevice = S
    xDen = Val(S) & "G*" & Mid(S, i, 1)
    Set xRng = wB(1).Sheets("Layer").Cells.Find(xDevice, LookIn:=xlValues)
    If xRng Is Nothing Then
        Debug.Print "§ä¤£¨ì " & xDevice & vbTab & xDen
    Else
       Debug.Print "§ä¨ì " & xDevice & vbTab & xDen & " ¦b " & xRng.Address(, , , 1)
    End If
End Sub
 | 
 |