英文:
Insert a blank row above , "True" which is in column "T"
问题
我有一个工作表，它是从另一个工作表中填充的，该工作表可以有可变数量的行。
在这张工作表中，我尝试在“T”列中的“True”上方插入一行空白行。
在列D中的该空白行中，我想添加“>JOBSTART”。
然后我想再添加一行空白行，在所有“>JOBSTART”上方，除了它在“D2”中时。
在列D中的该空白行中，我想添加“>JOBEND”。
最后一行也将有“>JOBEND”。
我尝试了多个VBA，但没有一个能给我想要的结果。
我尝试了这个，但它只是在我的列表底部添加了一行空白行。
Sub InsertOneRowAboveBlankCells()
Dim sColBlnk As Range, ar As Range
Set sColBlnk = Range("s:s").SpecialCells(xlCellTypeBlanks)
For Each ar In sColBlnk.Areas
ar.Cells(1, 1).EntireRow.Insert
Next
End Sub
英文:
I have a worksheet, which is populated from another sheet, which can have a variable amount of rows.
In this worksheet I am trying to insert a blank row above , "True" which is in column "T".
In that Blank row in column D I want to add ">JOBSTART"
Then I want to add another blank row, above all " >JOBSTART" except WHEN IT IS IN "D2".
In that Blank row in column D I want to add ">JOBEND".
The last row would also have ">JOBEND".
I have tried multiple VBA's but nothing gives me the result I'm looking for.
I tried this but it just adds a blank row at the bottom of my list.
Sub InsertOneRowAboveBlankCells()
Dim sColBlnk As Range, ar As Range
Set sColBlnk = Range("s:s").SpecialCells(xlCellTypeBlanks)
For Each ar In sColBlnk.Areas
ar.Cells(1, 1).EntireRow.Insert
Next
End Sub
答案1
得分: 1
尝试
Sub InsertRow()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Application.ScreenUpdating = False
' 设置工作表对象
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 根据需要修改
' 如果值为"True"，则插入行
For i = ws.Cells(ws.Rows.Count, "T").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "T").Value = "True" Then
ws.Rows(i).Insert Shift:=xlDown
End If
Next i
' 对每个空白行输入"jobstart"
For i = 2 To ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(i, "D").Value = "" Then
ws.Cells(i, "D").Value = ">JOBSTART"
End If
Next i
' 如果值为"jobstart"，则插入行
For i = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row To 3 Step -1
If ws.Cells(i, "D").Value = ">JOBSTART" Then
ws.Rows(i).Insert Shift:=xlDown
End If
Next i
' 对每个空白行输入"jobend"
For i = 3 To ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(i, "D").Value = "" Then
ws.Cells(i, "D").Value = ">JOBEND"
End If
Next i
' 在列D中的最后一行添加">JOBEND"
ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1, "D").Value = ">JOBEND"
Application.ScreenUpdating = True
End Sub
英文:
try
Sub InsertRow()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Application.ScreenUpdating = False
' Set the worksheet object
Set ws = ThisWorkbook.Worksheets("Sheet1") ' modify accrodingly
' insert row if value "True"
For i = ws.Cells(ws.Rows.Count, "T").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "T").Value = "True" Then
ws.Rows(i).Insert Shift:=xlDown
End If
Next i
'enter jobstart for each blank rows
For i = 2 To ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(i, "D").Value = "" Then
ws.Cells(i, "D").Value = ">JOBSTART"
End If
Next i
' insert row if value jobstart
For i = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row To 3 Step -1
If ws.Cells(i, "D").Value = ">JOBSTART" Then
ws.Rows(i).Insert Shift:=xlDown
End If
Next i
'enter jobend for each blank rows
For i = 3 To ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(i, "D").Value = "" Then
ws.Cells(i, "D").Value = ">JOBEND"
End If
Next i
' Add ">JOBEND" to the last row in column D
ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1, "D").Value = ">JOBEND"
Application.ScreenUpdating = True
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论