通过VBA插入行时如何将单元格的值设置为与上面的单元格相同

问题描述 投票:0回答:1

我是 VBA 新手,到目前为止能够重新调整现有代码,但不太擅长编写它。

我正在尝试根据 B 列的值插入新行。我希望 A 列和 B 列具有与上面的行相同的值。

这是我到目前为止的代码:

Sub insertrow()

    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To 1000
        j = InStr(1, Cells(i, 2), "Mon", vbTextCompare)
        If j = 1 Then
            Cells(i + 1, 1).EntireRow.Insert
            Cells(i + 1, 1).Value = (i - 1)
            Cells(i + 1, 2).Value = (i - 1)
            Cells(i + 1, 3).Value = "ERP"
            i = i + 2
        Else
        End If
    Next i

End Sub

目前 (i - 1) 给出的行号为 -1,这并不完全是我想要的。

enter image description here

开始时的表格

enter image description here

我希望它出现在宏之后的表格

抱歉,如果这真的很基本!

excel vba
1个回答
0
投票

插入匹配行

Sub InsertMondayRows()

    ' Define constants.
    Const FIRST_ROW As Long = 2

    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, specify it by name or use 'ActiveWorkbook'.
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    
    ' Calculate the last row in the 'Day' column.
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' Declare additional variables
    Dim cell As Range, Row As Long
    
    ' Loop through the rows of the table from the bottom to the top.
    For Row = LastRow To FIRST_ROW Step -1
        ' Reference the cell in the current row of the 'Day' column.
        Set cell = ws.Cells(Row, "B")
        ' Check if it's a match.
        If StrComp(CStr(cell.Value), "Mon", vbTextCompare) = 0 Then ' equal
        'If InStr(1, CStr(cell.Value), "Mon", vbTextCompare) = 1 Then ' begins w
            ' Reference the current entire row (range).
            With cell.EntireRow
                ' Insert a new row below the current row copying its formatting.
                .Offset(1).Insert Shift:=xlShiftDown, _
                    CopyOrigin:=xlFormatFromLeftOrAbove
                ' Copy the values from columns 'A' and 'B' from the current row
                ' to the same columns of the inserted row.
                .Offset(1).Columns("A").Value = .Columns("A").Value
                .Offset(1).Columns("B").Value = .Columns("B").Value
                ' Write to columns 'C' of the inserted row.
                .Offset(1).Columns("C").Value = "ERP"
            End With
        'Else ' no match; do nothing
        End If
    Next Row

    ' Inform.
    MsgBox "Monday rows inserted.", vbInformation

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.