Question

如果有人能帮我解决这个问题，我会很兴奋。

A：H与J：P的列需要按金额进行比较。此信息按金额排序，我想找到差异，当我有差异时，我想插入行，直到我们有匹配。为了更好地理解，我将举一个例子。这是比较两个系统，看看哪个系统有差异。 PS：我们比较的G和J列始终按数量

升序排序

Issue

RESULT 如果金额匹配，红色冒号是我手动验证的方式。我想更好地了解如何做到这一点

Answer 1

让您了解算法的工作原理。

这是在运行代码之前假定的......

... I列中的公式为=G:G-J:J
...列G和J按升序排列

否则该算法无效。

现在我们可以假设......

...如果I中的值为< 0，则右侧需要空白
...如果I中的值为> 0，则左侧需要空白
...如果I中的值为= 0，则无需执行任何操作

这就是我们在下面做的事情：

Option Explicit

Public Sub InsertBlanks()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Const fRow As Long = 2  'this is the row we start

    Dim lRow As Long
    lRow = ws.Cells(ws.Cells.Rows.Count, "J").End(xlUp).Row 'find last row in column J

    Dim iRow As Long
    For iRow = fRow To lRow
        If ws.Cells(iRow, "I").Value < 0 Then 'right side needs a blank line
            ws.Range("I" & iRow & ":P" & iRow).Insert Shift:=xlDown 'move right side one down
            ws.Range("I" & iRow).Formula = "=G:G-J:J" 're-add the formula
        ElseIf ws.Cells(iRow, "I").Value > 0 Then 'left side needs a blank line
            ws.Range("A" & iRow & ":I" & iRow).Insert Shift:=xlDown
            ws.Range("I" & iRow).Formula = "=G:G-J:J"
        End If
    Next iRow
End Sub

Answer 2

因为我希望代码在当前工作表上运行，所以我放了Set ws = ActiveSheet。由于未知原因，代码在测试中提出了相同的问题，所以我增加了等待时间，以避免一些excel冻结。 Range("A1").Select包含在代码中，否则它将仅在右列J：P中添加的代码首先在我的示例中给出。

` Option Explicit

Public Sub InsertBlanks()
Dim ws As Worksheet

Set ws = ActiveSheet

Range("A1").Select 

Const fRow As Long = 2  'this is the row we start

Dim lRow As Long
lRow = ws.Cells(ws.Cells.Rows.Count, "J").End(xlUp).Row 'find last row in column J

Dim iRow As Long
For iRow = fRow To lRow
        ws.Range("I" & iRow).Formula = "=G:G-J:J" 'add the formula
    If ws.Cells(iRow, "I").Value < 0 Then 'right side needs a blank line
        ws.Range("I" & iRow & ":P" & iRow).Insert Shift:=xlDown 'move right side one down
        ws.Range("I" & iRow).Formula = "=G:G-J:J" 're-add the formula
            Application.Wait (Now + TimeValue("0:00:01") / 5) 'wating time hh:mm:ss diveded by 5
    ElseIf ws.Cells(iRow, "I").Value > 0 Then 'left side needs a blank line
        ws.Range("A" & iRow & ":I" & iRow).Insert Shift:=xlDown
        ws.Range("I" & iRow).Formula = "=G:G-J:J" 're-add the formula
            Application.Wait (Now + TimeValue("0:00:01") / 5) 'wating time hh:mm:ss diveded by 5
    End If

Next iRow
End Sub`

Excel VBA - 比较两列并在每列中添加行，直到匹配为止

2 个答案: