- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2015-11-27 08:18
| 只看該作者
本帖最後由 GBKEE 於 2015-11-28 05:48 編輯
回復 5# v03586
一步一步來- Option 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("開機數計算程式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 即時算視窗 顯示
- 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 & " 在 " & xRng.Address(, , , 1)
- End If
- End Sub
|
|
發表於 2015-10-18 12:13
| 
發表於 2015-11-28 22:14
| 
