我是 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,这并不完全是我想要的。
开始时的表格
我希望它出现在宏之后的表格
抱歉,如果这真的很基本!
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