宏無法正確復制行。

Question

此宏的目的是從日志中復制某些信息並從中創建采購訂單。 代碼本身可以工作，但是我無法復制正確的信息。 每個日志可以具有許多不同的數據行，因此代碼將對其進行篩選並找到某些關鍵字，然后假定該信息從該列中獲取，但可能相距1-11行。 那就是我遇到問題的地方。

我需要它來查找關鍵字，然后根據需要提取的信息遍歷x行數，然后將其放入特定位置的PO中。 我目前正在使用xlToRight，但我似乎無法弄清楚如何正確使用它。

您可以看到每個部分都已布局，我知道可能有更好的方式編寫代碼，但是我對此不太擔心。

任何幫助將不勝感激！ 謝謝！

Sub Extract_job_info()

Dim Title As String
Dim Param As String
Dim Message As String
Dim defaultRef As String
Dim Sht As Worksheet, shtJob As Worksheet
Dim POSheet As Worksheet
Dim CreatePO As Integer
Dim InRowB As Long
Dim InColB As Range

Set POSheet = Sheets("Request for PO Template")

'set message details
Title = "Job Number"
Message = "Please enter the job number you would like to extract information from."
defaultRef = "Enter job number here"

Param = InputBox(Message, Title, defaultRef)

'find sheet
For Each Sht In ThisWorkbook.Worksheets
    If UCase(Sht.Name) = UCase(Param) Then
        Set shtJob = Sht
        Exit For
    End If
Next Sht

'If job does not exist
If shtJob Is Nothing Then
    MsgBox ("Sheet for '" & Param & "' was not found !")
Else
    If MsgBox("Would you like to extract job number '" & _
       Param & "' to make a PO?", vbYesNo, "Confirm") = vbYes Then

        InRowB = 2 'for testing


        'search for travel hours total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then

            POSheet.Range("F30").Value = InColB.End(xlToRight).Value

        Else
            MsgBox "'Cost' cell not found!", vbCriticalInColB.End(xlToRight).Value
        End If 'found "travel hours total"
        'search for travel hours amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B30").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "travel hours amount"




        'search for Regular Hours total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F31").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "regular hours total"
        'search for regular hours total
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B31").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "regular hours amount"





        'search for OT hours total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F32").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "OT total"
        'search for OT hours amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B32").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "OT amount"



        'search for Engineering hours total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F33").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Engineering hours total"
        'search for Engineering hours amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B33").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Engineering amount"




        'search for Engineering OT total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F34").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Engineering OT total"
        'search for Engineering OT amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B34").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Engineering OT amount"



        'search for Milage total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F36").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Milage total"
        'search for milage amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B34").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "milage amount"






        'search for Travel & Lodging  total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F35").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Travel & Lodging hours total"
        'search for Travel & Lodging amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B35").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Travel & Lodging amount"




        'search for Milage total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F36").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Milage total"
        'search for milage amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B37").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "milage amount"




        'search for Parts total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F38").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "parts total"
        'search for parts amount
        Set InColB = Sht.Columns(InRowB).Find(What:="Grand Total", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("B38").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "milage amount"




        'search for Freight total
        Set InColB = Sht.Columns(InRowB).Find(What:="Cost", _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, MatchCase:=False)

        If Not InColB Is Nothing Then
            POSheet.Range("F42").Value = InColB.End(xlToRight).Value
        Else
            MsgBox "'Cost' cell not found!", vbCritical
        End If 'found "Freight total"


     End If 'user confirmed extract

End If 'got sheet




End Sub

Answer 1

OFFSET方法是否滿足您的需求？ OFFSET返回一個Range相對於另一對象Range使用語法對象.OFFSET(rowOffset, columnOffset) 例如， Range("A1").Offset(1,2)返回單元格C2 （下方1行，右側2列）。

在您的情況下，似乎InColB是需要補償的范圍。 由於只需要Offset列，因此語法類似於InColB.Offset(,4)

這有幫助嗎？