Question

我的查询是，如果我使用按钮插入行，它还应该向1,2,3等行添加序列号...

我在工作表的Sheet1中有以下代码，用于在添加行时添加序列号

Private Sub Worksheet_Change1(ByVal Target As Range)
    Dim StartNum As Integer
    Dim FirstCell As Integer
    Dim LastCell As Integer

    StartNum = 2
    FirstCell = 3
    LastCell = 17

    Application.EnableEvents = False
    Do While FirstCell <= LastCell
        Range("B" & FirstCell).Value = StartNum
        FirstCell = FirstCell + 1
        StartNum = StartNum + 1
    Loop
    Range("B" & LastCell + 1).Value = ""
    Application.EnableEvents = True
End Sub

下面的代码写在module1中，用于插入公式为A1的行复制到新行

Sub Macro2()
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1:D1").Select
    Selection.AutoFill Destination:=Range("B1:D2"), Type:=xlFillDefault
    Range("B1:D2").Select
End Sub

现在我的问题是如何在插入行

时从Module Macro2代码调用private sub

任何建议，最早等待您的回复。

Answer 1

就像我提到的那样，你不需要Worksheet_Change代码。将以下代码粘贴到模块中并尝试..

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long

    '~~> Set this to the relevant sheet
    Set ws = Sheets("Sheet1")

    With ws
        '~~> Insert at row 2
        .Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        '~~> Autofill B1:D1 to C1:D2
        .Range("B1:D1").AutoFill Destination:=.Range("B1:D2"), Type:=xlFillDefault

        '~~> Find the last row
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                               After:=.Range("A1"), _
                               Lookat:=xlPart, _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False).Row
        Else
            lRow = 1
        End If

        '~~> Renumber the cells in Col B
        For i = 1 To lRow
            .Range("B" & i).Value = i
        Next i
    End With
End Sub

<强>后续

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long, j As Double

    '~~> Set this to the relevant sheet
    Set ws = Sheets("Sheet1")

    With ws
        '~~> Insert at row 2
        .Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        '~~> Autofill B1:D1 to C1:D2
        .Range("B1:D1").AutoFill Destination:=.Range("B1:D2"), Type:=xlFillDefault

        '~~> Find the last row
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                               After:=.Range("A1"), _
                               Lookat:=xlPart, _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False).Row
        Else
            lRow = 1
        End If

        '~~> Renumber the cells in Col B 1,1.1,1.2,1.3 etc
        j = 1

        For i = 1 To lRow
            .Range("B" & i).Value = j
            j = j + 0.1
        Next i
    End With
End Sub

我想从excel中的工作表调用private sub，值应该在sheet1中更改

1 个答案: