0

私のクエリは、ボタンを使用して行を挿入する場合、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

以下のコードは、新しい行にコピーされた A1 の数式で行を挿入するために module1 に記述されています。

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

今私の質問は、行を挿入しながらモジュール Macro2 コードからプライベート サブを呼び出す方法です。

どんな提案でも、できるだけ早くあなたの返事を待っています。

4

1 に答える 1

0

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
于 2013-01-16T14:42:49.883 に答える