Excel VBA：查找当前行号并在条件中插入一行

我目前正在写一个macros，逐字逐行比较Excel和另一个程序之间的值。 99％的时间，这是因为一个交易从来没有增加。 所以，当这个macros比较这些值时，如果发现差异，我希望它添加一个新的“行”（但是，不是整行，只能从A_:K_ ，其中_是活动单元格的行号）。 这将允许我简单地进入Excel，input事务，然后按下macros上的OK并继续。 我的macros实际上很简单，很简短，所以我可以继续前进，在这里发布整个事情，以便更好地理解发生的事情。 而且我不是在Excel的VBA中这样做，我在另一个程序的VBA中这样做，而appXL是Excel的对象作为函数：

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

主要macros观：

 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 ，手动selectA495:K495的范围A495:K495 ，右键单击select，单击Insert ，然后单击Shift Cells Down 。 现在我只需要这个自动化。 最后，我还计划自动填写缺失的数据，但这部分是先来的（否则我会继续手动自己做这个）。

作为一个额外的好处 ，如果有人也可以解释如何获取当前行号插入行，我可以将此行号添加到debugging窗口 – 但如果有必要，我可以没有生活

Answer 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) 

Answer 2

根据上面的评论，我会采取@Categoriesashu的答案，并运行一点点。 使用Active*对象转换代码并使用Activate和Select将使代码更容易维护和扩展。 这里有一个示例重构使用绝对引用，而不是（给你一个想法）。 这显然是未经testing – 我甚至不知道它正在运行的应用程序。 😛

 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