Excel VBA:查找当前行号并在条件

时间:2016-09-01 00:45:18

标签: excel vba excel-vba macros

我目前正在编写一个宏,它实际上比较了Excel和另一个程序之间的逐行值。 99%的时间,当存在差异时,这是因为从未添加过交易。因此,虽然这个宏正在比较这些值,但在发现差异时,我希望它添加一个新的"行" (但是,不是整个行,仅来自A_:K_,其中_是活动单元格的行号。这将允许我简单地进入Excel,键入事务,然后按宏上的确定并继续。我的宏实际上很简单,很简单。到了这一点,所以我可以继续发布这里的所有内容,以便更好地了解正在发生的事情。我不是在Excel的VBA中这样做,我在其他程序的VBA中这样做,appXL是Excel的对象作为函数:

Function appXL As Object
    Set appXL = GetObject(, "Excel.Application")
End Function

主要宏:

Sub FeeBrdVerifier
    On Error Resume Next
    With InitSession
        Dim iComm As Currency   ' Compare this with Excel's data
        Dim sComm As String     ' Needed string to allow app to stop at end of report
        Dim xL As Currency      ' Compare this with Host's data
        Dim Counter As Byte     ' Counter for the loop (need to do a new page)
        Dim r As Byte           ' Row # on the page
        Dim Page As Byte

        Page = 1
        Debug.Print "Page # " & Page & vbNewLine & "========="
        Counter = 0     ' 19 unique lines in transaction board per page

        appXL.Workbooks("2016 FEE BOARD.xlsx").Activate
        appXL.Range("J2").Select    'Starting point of the transaction amounts
        r = 3

        Do
            Counter = Counter + 1
            .Copy 69, r, 78, r      ' This copies text from host app, consider it a 'cell'
            sComm = Clipboard
            iComm = CCur(sComm)
            xL = appXL.ActiveCell.Value
            appXL.ActiveCell.Offset("1", "0").Select
            Debug.Print "# [" & Format(Counter,"00") & "].. sComm = [" & sComm & "] ... Excel Value = [" & xL & "]"
            If iComm <> xL Then
                .SetSelection 0, r, 80, r   'Highlights the row in host app that doesnt match
    '           appXL.      '<<<< where I need assistance, insert line and shift down
                MsgBox "Did not match..."
                .ClearSelection     'Get rid of highlight after msgbox cleared
            End If
            r = r + 1               ' This allows the loop to copy the next line
            If Counter = 19 Then
                Page = Page + 1
                Counter = 0
                .Output E           ' E is a function I use for the Return Key
                Sleep 250           ' Waiting for next page to load
                r = 3               ' On a new page now, go back to the top
                Debug.Print vbNewLine & "Page # " & Page & vbNewLine & "========="
            End If
        Loop Until sComm = ""   ' Reached last transaction
    End With
End Sub

因此,回顾一下,如果活动单元格为J495,请手动选择A495:K495范围,右键单击选择,单击Insert,然后单击{ {1}}。现在我只需要将其自动化。最终我还计划自动填写缺失的数据,但这部分是第一个(或者我会继续自己手动完成)。

作为一个额外的好处,如果有人也可以解释如何获取插入行的当前行号,我将不胜感激,因此我可以将此行号添加到调试器窗口 - 但我如果没有必要可以生活

2 个答案:

答案 0 :(得分:1)

这应该适用于你想要做的事情

  .SetSelection 0, r, 80, r 
    appXL.ActiveSheet.Range(appXL.cells(appXL.activecell.Row,1),appXL.cells(appXL.activecell.Row,11)).Insert Shift:=xlDown
    MsgBox "Did not match..." & " the current row number is : " & appXL.ActiveCell.Row()



  'Then move to next row to continue the loop
    appXL.ActiveCell.Offset(1)

答案 1 :(得分:1)

根据上面的评论,我会接受@ cyboashu的回答并稍微运行一下。使用Active*对象转换代码并使用ActivateSelect将使代码更易于维护和扩展。这是一个使用绝对引用的示例重构(为了给你一个想法)。这显然是未经测试的 - 我甚至不知道它正在运行什么应用程序。 :-P

Sub FeeBrdVerifier()
    On Error Resume Next
    With InitSession
        Dim iComm As Currency   ' Compare this with Excel's data
        Dim sComm As String     ' Needed string to allow app to stop at end of report
        Dim xL As Currency      ' Compare this with Host's data
        Dim Counter As Byte     ' Counter for the loop (need to do a new page)
        Dim r As Byte           ' Row # on the page
        Dim Page As Byte

        Page = 1
        Debug.Print "Page # " & Page & vbNewLine & "========="
        Counter = 0     ' 19 unique lines in transaction board per page

        'Get a reference to the ActiveSheet
        Dim sheet As Object
        Set sheet = appXL.Workbooks("2016 FEE BOARD.xlsx").ActiveSheet

        r = 3

        Dim currentRow As Long
        currentRow = 2 'Starting point of the transaction amounts in Column J (ordinal is 10)
        Do
            Counter = Counter + 1
            .Copy 69, r, 78, r      ' This copies text from host app, consider it a 'cell'
            sComm = Clipboard
            iComm = CCur(sComm)
            xL = sheet.Cells(currentRow, 10).Value
            currentRow = currentRow + 1
            Debug.Print "# [" & Format(Counter, "00") & "].. sComm = [" & sComm & "] ... Excel Value = [" & xL & "]"
            If iComm <> xL Then
                .SetSelection 0, r, 80, r   'Highlights the row in host app that doesnt match
                sheet.Range(sheet.Cells(currentRow, 1), sheet.Cells(currentRow, 11)).Insert
                MsgBox "Did not match..."
                .ClearSelection     'Get rid of highlight after msgbox cleared
            End If
            r = r + 1               ' This allows the loop to copy the next line
            If Counter = 19 Then
                Page = Page + 1
                Counter = 0
                .Output E           ' E is a function I use for the Return Key
                Sleep 250           ' Waiting for next page to load
                r = 3               ' On a new page now, go back to the top
                Debug.Print vbNewLine & "Page # " & Page & vbNewLine & "========="
            End If
        Loop Until sComm = vbNullString   ' Reached last transaction
    End With
End Sub