宏不正确复制行。

时间:2015-03-11 13:33:15

标签: excel vba

此宏的目的是从日志中复制某些信息并从中创建采购订单。代码本身有效,但我无法复制正确的信息。每个日志都可以有许多不同的数据行,因此代码会对其进行筛选并找到某些关键字,然后应该从该列中获取信息,但可能会在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

1 个答案:

答案 0 :(得分:1)

OFFSET方法是否满足您的需求? OFFSET使用语法Range返回相对于另一个Range对象的.OFFSET(rowOffset, columnOffset)个对象。例如,Range("A1").Offset(1,2)会返回单元格C2(下方1行,右侧2列)。

在您的情况下,似乎InColB是需要偏移的Range。由于您只需要Offset列,因此语法类似于InColB.Offset(,4)

这有帮助吗?