Question

我将电子表格拆分为多个部分，每个部分都有一个“添加新行”＆＃39;它添加到该部分中的现有行的位置。

我已经对Currentregion函数进行了计算，该函数对行进行了计数，但仍然选择最后一行，然后在下面添加一行。

到目前为止，代码是我能够添加新行的地方，但我正在寻找一个更清晰的精确解决方案，每个部分使用CurrentRegion - 这可以通过传入的sBudgetLine参数来完成。 / p>

Sub CopyToMaster()

Dim LastRow as Long, a as String

ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
    Worksheets(i).Activate
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & LastRow).Select

    'Storing the current location of the cell
    a = Selection.Address(RowAbsolute:= False, ColumnAbsolute:= False)

    Sheets("Master").Activate
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Select

    'Required after first paste to shift active cell down one
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop

    ' Pasting in a formula the corresponding workbook it references to and the cell's position
    Selection.Formula = "='" & Worksheets(i).Name & "'!" & a
Next i

End Sub

Answer 1

例如，如果您确定您的Range在A1中有数据，请使用以下代码：

Dim lastrow    as Integer

lastrow = Worksheets(sSheetName).Range("A1").CurrentRegion.Rows.Count
Rows(lastrow + 1).Select
Selection.Insert Shift:=xlDown

Answer 2

首先，摆脱所有选择。它们很慢并且容易导致错误。

例如，而不是

Rows(s).Select
Selection.Insert Shift:=xlDown

使用

Rows(s).Insert Shift:=xlDown

其次，您不需要将行号转换为字符串并修剪它。 &导致它们被转换为字符串。

我使用'删除了不必要的行，并添加了''的评论。

Sub AddNewAllocToSpendLine(sBudgetLine As String, Optional sSheetName As String = "Sheet3") 'c_Alloc2SpendSheetName)
'Adds new line to the list of allocated to spend

Dim c As Range
Dim lastRow As Long 'I renamed s so it's more obvious what it does

''this is to make sure we're always on the right sheet
With Worksheets(sSheetName)

    'get the budget line position
    ''range("A:A") or columns(1) is really just a matter of taste
    Set c = .Columns(1).Find(sBudgetLine, LookIn:=xlValues)
    If Not (c Is Nothing) Then
        ''instead of selecting the cell in the last row, we find the index of the last row and use that instead
        's = Trim(Str(c.Row)) 'you don't use s before resetting it?
        'Range("B" & Trim(Str(c.Row))).Select
        'Selection.End(xlDown).Select
        lastRow = .Cells(c.Row, 2).End(xlDown).Row 'see how you can skip all the selecting?

        ''just insert the lines directly
        'If Selection.Value = "Period" Then
        If .Cells(lastRow, 2).Value = "Period" Then
            .Rows(lastRow + 2).Insert Shift:=xlDown
            lastRow = lastRow + 2
        Else
            .Rows(lastRow + 1).Insert Shift:=xlDown
            lastRow = lastRow + 1
        End If

        ''what is this for? Rows("4:4") works but it's unnecessary
        's = s & ":" & s

        ''remove selection
        'Rows(s).Select
        'Selection.Insert Shift:=xlDown
        ''this is what you'd do if you didn't insert the row above
        'Rows(s).Insert Shift:=xlDown

        ''instead of copying, just assign the range
        's = Trim(Str(Selection.Row)) 'why? you don't use it anymore
        'Range("E10").Copy
        'Cells(Selection.Row, 5).Select
        'ActiveSheet.Paste
        'Application.CutCopyMode = False
        .Cells(lastRow, 5) = .Cells(10, 5)

        ''is this really necessary?
        'Range("A" & Trim(Str(c.Row))).Select
        .Cells(c.Row, 1).Select
    End If
End With
End Sub

将新行添加到节vba中的选定行

2 个答案: