Excel宏将一直运行，直到有值为止

我为以下excel记录了一个宏：-

宏代码：-

Sub Macro4()
'
' Macro4 Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "P"
    Range("B1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$13").AutoFilter Field:=3, Criteria1:="Credit"
    Range("B3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=-RC[-1]"
    Range("B3").Select
    Selection.Copy
    Range("A3").Select
    Selection.End(xlDown).Select
    Range("B12").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B11").Select
    ActiveSheet.Range("$A$1:$C$13").AutoFilter Field:=3, Criteria1:="Debit"
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]"
    Range("B2").Select
    Selection.Copy
    Range("A2").Select
    Selection.End(xlDown).Select
    Range("B13").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.End(xlUp).Select
    ActiveSheet.ShowAllData
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    Application.CutCopyMode = False
    Columns("A:B").Select
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    Range("B1").Select
    Selection.AutoFilter
End Sub

结果如下：-

当我在下面的excel上尝试相同的宏时：-

这将给出以下结果

---

实际上，我不知道有多少个价格，所以如何编辑我的宏，使它选择所有范围，直到最后一行，这个宏将在activesheet中运行。因此，请在运行此宏之前选择图纸。或者添加第一行以提及工作表

Sub Macro4()
' Keyboard Shortcut: Ctrl+Shift+D
Range("A1").Select
Dim tblRng As Range, cl As Range

Columns("B:B").Insert Shift:=xlToRight
Range("B1").FormulaR1C1 = "P"

Set tblRng = Range("A2", Range("C" & Rows.Count).End(xlUp))

For Each cl In Range(tblRng.Cells(1, 2), tblRng.Cells(tblRng.Rows.Count, 2))
If cl.Offset(0, 1) = "Credit" Then cl = -cl.Offset(0, -1)
If cl.Offset(0, 1) = "Debit" Then cl = cl.Offset(0, -1)
Next

Range(tblRng.Cells(1, 1), tblRng.Cells(tblRng.Rows.Count, 2)).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "


End Sub

---

此宏将在activesheet中运行。因此，请在运行此宏之前选择图纸。或者添加第一行以提及工作表

Sub Macro4()
' Keyboard Shortcut: Ctrl+Shift+D
Range("A1").Select
Dim tblRng As Range, cl As Range

Columns("B:B").Insert Shift:=xlToRight
Range("B1").FormulaR1C1 = "P"

Set tblRng = Range("A2", Range("C" & Rows.Count).End(xlUp))

For Each cl In Range(tblRng.Cells(1, 2), tblRng.Cells(tblRng.Rows.Count, 2))
If cl.Offset(0, 1) = "Credit" Then cl = -cl.Offset(0, -1)
If cl.Offset(0, 1) = "Debit" Then cl = cl.Offset(0, -1)
Next

Range(tblRng.Cells(1, 1), tblRng.Cells(tblRng.Rows.Count, 2)).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "


End Sub

---

你也可以用这个公式

B2=IFERROR(IF(C2="credit",A2*(-1),(IF(C2="Debit"),A2,""),""),"") 

然后在列上使用条件格式来获得颜色。 如果坚持使用宏，可以添加find last row并循环所有行以检查列C的值。 应该很容易找到和复制从谷歌，有很多类似的例子

---

仔细检查公式，我已经在我的手机上写好了，但应该没问题

你也可以用公式来做这个

B2=IFERROR(IF(C2="credit",A2*(-1),(IF(C2="Debit"),A2,""),""),"") 

然后在列上使用条件格式来获得颜色。 如果坚持使用宏，可以添加find last row并循环所有行以检查列C的值。 应该很容易找到和复制从谷歌，有很多类似的例子

---

仔细检查公式，我已经在我的手机上写了，但应该没问题

请尝试此代码。它采取了不同的方法

Sub BookToLedger()

    Dim Rng As Range
    Dim Cell As Range
    Dim R As Long

    Application.ScreenUpdating = False

    With Worksheets("Sheet1")       ' change tab name to suit
        Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        .Columns(2).Insert Shift:=xlToRight
        .Cells(1, 2).Value = "Amount"
    End With

    With Rng
        .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
        .Copy Destination:=.Offset(0, 1)
        Set Rng = .Offset(0, 1)
    End With

    For Each Cell In Rng.Cells
        With Cell
            If Left(.Offset(0, 1).Value, 2) = "Cr" Then
                .Value = .Value * -1
            End If
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

---

代码首先在A列中设置数字格式。然后在新的B列中插入A列的副本，包括新的数字格式。最后，它循环遍历B列中的所有条目，并使信用值为负值。

请尝试此代码。它采取了不同的方法

Sub BookToLedger()

    Dim Rng As Range
    Dim Cell As Range
    Dim R As Long

    Application.ScreenUpdating = False

    With Worksheets("Sheet1")       ' change tab name to suit
        Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        .Columns(2).Insert Shift:=xlToRight
        .Cells(1, 2).Value = "Amount"
    End With

    With Rng
        .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
        .Copy Destination:=.Offset(0, 1)
        Set Rng = .Offset(0, 1)
    End With

    For Each Cell In Rng.Cells
        With Cell
            If Left(.Offset(0, 1).Value, 2) = "Cr" Then
                .Value = .Value * -1
            End If
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

代码首先在A列中设置数字格式。然后在新的B列中插入A列的副本，包括新的数字格式。最后，它循环遍历B列中的所有条目，并使信用值为负值。

我的建议是：

Option Explicit

Sub InsColP()

    Dim rg As Range
    Dim wks As Worksheet
    Set wks = ActiveSheet

    Columns("B:B").Insert Shift:=xlToRight


    With wks
        .Cells(1, 2) = "p"
        Set rg = .Range(.Cells(2, 2), .Cells(lastRow(1), 2))
    End With

    With rg
        .FormulaR1C1 = "=IF(RC[1]=""Debit"",RC[-1],-RC[-1])"
        .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    End With

End Sub

Function lastRow(col As Long, Optional wks As Worksheet) As Long

    If wks Is Nothing Then
        Set wks = ActiveSheet
    End If

    lastRow = wks.Cells(wks.Rows.Count, col).End(xlUp).Row

End Function

我的建议是

Option Explicit

Sub InsColP()

    Dim rg As Range
    Dim wks As Worksheet
    Set wks = ActiveSheet

    Columns("B:B").Insert Shift:=xlToRight


    With wks
        .Cells(1, 2) = "p"
        Set rg = .Range(.Cells(2, 2), .Cells(lastRow(1), 2))
    End With

    With rg
        .FormulaR1C1 = "=IF(RC[1]=""Debit"",RC[-1],-RC[-1])"
        .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    End With

End Sub

Function lastRow(col As Long, Optional wks As Worksheet) As Long

    If wks Is Nothing Then
        Set wks = ActiveSheet
    End If

    lastRow = wks.Cells(wks.Rows.Count, col).End(xlUp).Row

End Function