麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼

Sub 計算當日開機數()
Dim RepSht As Worksheet, RepArr, xD1, xD2, R&, C&
.
.
.
' 此處呼叫
GetSubTot
Application.GoTo xSht.[A2]
End Sub

複製代碼

Sub GetSubTot()
Dim Btm As Long, rPos As Long
With Sheets("開機數")
Btm = .Range("A" & Rows.Count).End(xlUp).Row
rPos = Sheets("開機數").UsedRange.End(xlToRight).Column
If (Cells(1, rPos) = "Total") Then rPos = rPos - 1
.Cells(1, rPos + 1) = "Total"
.Cells(2, rPos + 1).Resize(Btm - 1).Formula = "=SUM(F" & 2 & ":T" & 2 & ")"
.Cells(2, rPos + 1).Resize(Btm - 1) = .Cells(2, rPos + 1).Resize(Btm - 1).Value
.Cells(Btm + 1, "B") = " Total"
.Cells(Btm + 1, "F").Resize(, 16).Formula = "=SUM(F" & 2 & ":F" & Btm & ")"
.Cells(Btm + 1, "F").Resize(, 16) = .Cells(Btm + 1, "F").Resize(, 16).Value
End With
End Sub

複製代碼