查找文本，然后在下一行替换

Question

我以前使用过一个宏，该宏在工作簿中找到第一个空行，然后在接下来的9列中放置标记。这在一个项目中运行得很好，但我现在遇到了问题，因为宏不能总是找到我想要的确切的空白行(可能是因为格式的原因，我不确定(

这是我实现这个想法的代码：

Sub SetupTags(pintNumFeatures As Integer, pintNumRecords As Integer, pintSubGroupSize As Integer)
Dim lngRow As Long
Dim lngCol As Long
Dim lngTotal As Long
Dim lngCell As Long
Dim lngDataRow As Long
Dim lngDataCol As Long
Dim lngFirstRow As Long
lngFirstRow = FindFirstBlankRow
lngRow = lngFirstRow
lngCol = 9
lngTotal = pintNumFeatures * pintNumRecords
lngDataCol = 1
lngDataRow = 1
For lngCell = 1 To lngTotal
ActiveWorkbook.Worksheets(1).Cells(lngRow, lngCol).Value = "[act]{rowcol:" & lngDataRow & "," & lngDataCol & "}"
lngCol = lngCol + 1

If lngCol > 13 Then
lngRow = lngRow + 1
lngCol = 9
End If

lngDataRow = lngDataRow + 1
If lngDataRow > pintNumRecords Then
lngDataCol = lngDataCol + 1
lngDataRow = 1
End If
Next lngCell
'now figure out the column specific stuff
Dim intPartRows As Integer
Dim intPartRow As Integer
Dim intFeature As Integer
Dim intRecordNumber As Integer
intPartRows = CInt(pintNumRecords / 5)
lngRow = lngFirstRow
lngCol = 1
intRecordNumber = 1
For intFeature = 1 To pintNumFeatures
For intPartRow = 0 To intPartRows - 1
ActiveWorkbook.Worksheets(1).Cells(lngRow, 1).Value = "[part_" & intFeature & "]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 2).Value = "[dim_" & intFeature & "]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 3).Value = "[date]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 4).Value = "[date]{Row:" & intRecordNumber & "}"

ActiveWorkbook.Worksheets(1).Cells(lngRow, 5).Formula = "=AVERAGE(I" & lngRow & ":M" & lngRow & ")"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 6).Formula = "=MAX(I" & lngRow & ":M" & lngRow & ") - MIN(I" & lngRow & ":M" & lngRow & ")"


ActiveWorkbook.Worksheets(1).Cells(lngRow, 14).Value = "[tf1]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 15).Value = "[tf2]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 16).Value = "[tf3]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 17).Value = "[tf4]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 18).Value = "[tf5]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 19).Value = "[tf6]{Row:" & intRecordNumber & "}"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 20).Value = "[tf7]{Row:" & intRecordNumber & "}"


lngRow = lngRow + 1
intRecordNumber = intRecordNumber + 5
Next intPartRow
Next intFeature



End Sub
Function FindFirstBlankRow() As Long
Dim lngRow As Long
Dim lngFound As Long
'we need to check for blanks and not shaded to determine the actual last used row since the xlSpecialCells is not always accurate
'change this for each stage maybe 27 is the first empty row of stage 2 onwards we cannot have any empty rows passed this point'
For lngRow = 27 To 1000
If Sheet1.Cells(lngRow, 2).Value = "" Then
lngFound = lngRow
Exit For
End If
Next lngRow
FindFirstBlankRow = lngFound
End Function
Sub ReAddTags() 'pintNumFeatures As Integer, pintNumRecords As Integer, pintSubGroupSize As Integer)
Dim lngRow As Long
Dim lngFirstRow As Long
lngFirstRow = FindFirstBlankRow
lngRow = lngFirstRow
ActiveWorkbook.Worksheets(1).Cells(lngRow, 1).Value = "[All Feature Numbers]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 2).Value = "[ALL EXTRA INFO]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 4).Value = "[ALLLABELS]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 6).Value = "[allnoms]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 7).Value = "[FEATURE_SOURCES]"
ActiveWorkbook.Worksheets(1).Cells(lngRow, 9).Value = "[ACTROWS]"

End Sub

所以我需要用一种不同的方式来处理它，我在单词"的工作簿中有一个常量；序列"；它总是比我想重新引入这些标签的地方高出一行，所以我正在寻找类似于这个的东西

•查找下一个序列文本(这总是在我想放回标签的位置上方1行(•然后在下面移动一行，将标签添加回•需要有某种IF语句，表示如果此行中有文本，则跳到下一个序列文本(这将阻止它将标签放回已经填充数据的阶段(

我可以找到一些其他代码，它可以进行查找和替换，但没有任何高级代码可以跳过一行，也可以填充这个IF语句

Sub test()
Dim rngColumn       As Range
Dim rngCell         As Range
Set rngColumn = Worksheets("Sheet1").Columns("H")
For Each rngCell In rngColumn.Cells
If Trim(rngCell) <> "" Then
If Trim(rngCell) = "815" Then
rngCell.Value = "'0815"
End If
End If
Next rngCell
Set rngColumn = Nothing
Set rngCell = Nothing
End Sub

将非常感谢任何指导

Answer 1

要移动到列中的下一个可用行，可以使用：

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select