Question

我编写了以下代码，为电子表格中某个部分的行范围添加了一个新行。由于这些部分中有多个部分，因此sBudgetLine作为范围的起始值（部分名称）传入，该部分添加了额外的1以错过部分的标题（日期，描述和价格）。

一切正常，但是当偶尔添加行时，我硬编码的格式不起作用，并在页面下方添加额外的行以及在正确位置的新行。

Sub AddNewAllocToSpendLine(sBudgetLine As String, Optional sSheetName As String = c_Alloc2SpendSheetName)

Dim c As Range
Dim N As Long
Dim lastRow As Long
Dim formula As Range
Dim rng As Range

With Worksheets(sSheetName)

    Set c = .Columns(1).Find(sBudgetLine, LookIn:=xlValues)
    If Not (c Is Nothing) Then

        lastRow = .Cells(c.Row, 2).End(xlDown).Row

        Worksheets(sSheetName).Activate
        Worksheets(sSheetName).Range("B" & lastRow + 1, "E" & lastRow + 1).Activate

        Selection.EntireRow.Insert Shift:=xlDown

        Selection.Range("B" & ActiveCell.Row, "E" & ActiveCell.Row).Interior.Color = RGB(255, 255, 255)

        With Selection.Range("B" & ActiveCell.Row, "D" & ActiveCell.Row).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 1
            End With

        Selection.Cells(1, 4).formula = "=IF(" & "D" & ActiveCell.Row & "="""","""",IF(" & "D" & ActiveCell.Row & ">14999.99,""Minimum 3 formal competitive tenders - inform PSU"",IF(" & "D" & ActiveCell.Row & ">2499.99,""Minimum 3 written quotes based on written specification"",IF(" & "D" & ActiveCell.Row & ">999.99,""Minimum 3 written quotes"",IF(" & "D" & ActiveCell.Row & ">499.99,""Minimum 3 oral quotes"",IF(" & "D" & ActiveCell.Row & ">249.99,""One written or verbal quote"",""One written or verbal quote""))))))"

    End If
End With
End Sub

我已经尝试了各种各样的方法并且无法弄清楚什么是错的，这可能是一个虚假的故障吗？如果是这种情况，是否有更好的方法来为添加的行提供格式？

Answer 1

您开始使用With ... End With statement引用父工作表，然后似乎放弃了它。如果包含您想要.Activate的单元格的较大单元格块已经是.Selection，则选择不会更改，只会更改ActiveCell property。

最好避免完全使用Range .Select方法和Range .Activate方法¹。

Sub AddNewAllocToSpendLine(sBudgetLine As String, Optional sSheetName As String = c_Alloc2SpendSheetName)

    Dim rw As Variant, nr As Long

    With Worksheets(sSheetName)
        rw = Application.Match(sBudgetLine, .Columns(1), 0)
        If Not IsError(rw) Then
            nr = .Cells(rw, "B").End(xlDown).Row + 1
            .Rows(nr).EntireRow.Insert Shift:=xlDown
            With .Range(.Cells(nr, "B"), .Cells(nr, "E"))
                .Interior.Color = RGB(255, 255, 255)
                With .Borders
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 1
                End With
                .Cells(1, 4).formula = _
                    "=IF(D" & nr & "=TEXT(,), TEXT(,), " & _
                     "IF(D" & nr & ">14999.99, ""Minimum 3 formal competitive tenders - inform PSU"", " & _
                     "IF(D" & nr & ">2499.99, ""Minimum 3 written quotes based on written specification"", " & _
                     "IF(D" & nr & ">999.99, ""Minimum 3 written quotes"", " & _
                     "IF(D" & nr & ">499.99, ""Minimum 3 oral quotes"", " & _
                     "IF(D" & nr & ">249.99, ""One written or verbal quote"", " & _
                        """One written or verbal quote""))))))"
            End With
        End If

    End With
End Sub

TEXT(,)只是一种编写""的方式，无需将其作为""""写入字符串。

.¹_{有关远离依赖select和activate以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。}

在VBA中添加新的行故障

1 个答案: