連続して固まっているﾃﾞｰﾀ毎に､指定のｷｰﾜｰﾄﾞが文字列に含まれていたら､上に1ｾﾙ､右に6ｾﾙ移動したM･N列のｾﾙそれぞれに､★ﾏｰｸ(M列)､●ﾏｰｸ(N列)を…

連続して固まっているﾃﾞｰﾀ毎に､指定のｷｰﾜｰﾄﾞが文字列に含まれていたら､上に1ｾﾙ､右に6ｾﾙ移動したM･N列のｾﾙそれぞれに､★ﾏｰｸ(M列)､●ﾏｰｸ(N列)を入れたい｡

Excelの質問です｡今､G列に文字列(半角ｽﾍﾟｰｽなど含む)がｽﾞﾗﾘと入ってるｾﾙ､何も入ってない空白ｾﾙ併せて､10万行ぐらいあります｡
最初のﾃﾞｰﾀは5?39行目(?)､そして空白ｾﾙがあり､次のﾃﾞｰﾀは42?83行目(?)､そして空白ｾﾙ､その次は88?123行目(?)と､特に規則性はないですが､空白ｾﾙが出てきたら区切りとし､それぞれのﾃﾞｰﾀを固まりとして考えます｡

そして空白ｾﾙ除くﾃﾞｰﾀの固まりの中で､?と?の固まりには“ﾋﾟﾗﾐｯﾄﾞ”という文字列が入ってます｡42?83行目､88?123行目､全ての行の文字列に“ﾋﾟﾗﾐｯﾄﾞ”という文字が何らかの形で入っています｡

この状況におきまして｡

ﾃﾞｰﾀの固まりごとに､最初に“ﾋﾟﾗﾐｯﾄﾞ”と出てきたｾﾙから上に1ｾﾙ､右に6ｾﾙ移動したM･N列のｾﾙそれぞれに､★ﾏｰｸ(M列)と●ﾏｰｸ(N列)を入れたいのです｡

G列が空白区切りでひとつのﾌﾞﾛｯｸとして考えて､その中で最初に｢ﾋﾟﾗﾐｯﾄﾞ｣を見つけたらﾏｰｸをつければ良いんですよね？
42?83行目(?)のﾌﾞﾛｯｸで､45行目と50行目だけにﾋﾟﾗﾐｯﾄﾞの文字が含まれていて､その他の行にはﾋﾟﾗﾐｯﾄﾞの文字はない｡
そういう場合には､44行目の M･N列だけに ★･● を打つ(49行目には打たない)｡

こんな感じでどうでしょう｡

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub mark_first_word()
 Const M_SEARCH_WORD = 1
 Const M_NEXT_BLOCK = 2

 target_col = 7  ' G列
 last_row = Cells(Rows.Count, target_col).End(xlUp).Row
 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = "ﾋﾟﾗﾐｯﾄﾞ"  ' 検索する単語

 Range(Cells(2, 13), Cells(last_row, 14)).Clear

 Mode = M_SEARCH_WORD

 For r = 5 To last_row
 Set c = Cells(r, target_col)
 If Mode = M_SEARCH_WORD Then
 If is_blank_cell(c) Then
 Mode = M_NEXT_BLOCK
 End If
 ElseIf Mode = M_NEXT_BLOCK Then
 If Not is_blank_cell(c) Then
 Mode = M_SEARCH_WORD
 End If
 End If
 If Mode = M_SEARCH_WORD Then
 If re.test(c.Value) Then
 Cells(r - 1, target_col + 6).Value = "★"
 Cells(r - 1, target_col + 7).Value = "●"
 End If
 End If
 DoEvents
 Next
End Sub

標準ﾓｼﾞｭｰﾙに､上記のｺｰﾄﾞを貼り付けて､mark_first_word ｻﾌﾞﾙｰﾁﾝを実行してください｡

(追記です)

でもすみません､ﾃﾞｰﾀの固まりの､一番上に“ﾋﾟﾗﾐｯﾄﾞ”とある文字列だけを対象としたいのですが｡

ﾌﾞﾛｯｸの先頭の行の G列にﾋﾟﾗﾐｯﾄﾞが含まれる場合に､★と●ですか｡

これではどうでしょう？

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub mark_first_word()
 Const M_CHECK_WORD = 1
 Const M_NEXT_BLANK = 2
 Const M_NEXT_BLOCK = 3

 target_col = 7  ' G列
 last_row = Cells(Rows.Count, target_col).End(xlUp).Row
 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = "ﾋﾟﾗﾐｯﾄﾞ"  ' 検索する単語

 Range(Cells(2, 13), Cells(last_row, 14)).Clear

 Mode = M_CHECK_WORD

 For r = 5 To last_row
 Set c = Cells(r, target_col)
 If Mode = M_NEXT_BLANK Then
 If is_blank_cell(c) Then
 Mode = M_NEXT_BLOCK
 End If
 ElseIf Mode = M_NEXT_BLOCK Then
 If Not is_blank_cell(c) Then
 Mode = M_CHECK_WORD
 End If
 End If
 If Mode = M_CHECK_WORD Then
 If re.test(c.Value) Then
 Cells(r - 1, target_col + 6).Value = "★"
 Cells(r - 1, target_col + 7).Value = "●"
 End If
 Mode = M_NEXT_BLANK
 End If
 DoEvents
 Next
End Sub

これで意図した結果になりますでしょうか？
行をﾌﾙｽｷｬﾝしないようにしてあるので
その分は早いかと･･･

全ての行の文字列に“ﾋﾟﾗﾐｯﾄﾞ”という文字が何らかの形で入っています｡

これを信用してよいのであれば､Forのﾙｰﾌﾟと
"ﾋﾟﾗﾐｯﾄﾞ"の文字列判定のIfを無くせます｡

Public Sub addMark()

 Const TARGET_SHEET_NAME As String = "Sheet1"
 Const BEGIN_ROW As Long = 5
 Const SEARCH_COL As String = "G"
 Const MARK_COL_STAR As String = "M"
 Const MARK_COL_CIRCLE As String = "N"
 Const MARK_STAR As String = "★"
 Const MARK_CIRCLE As String = "●"
 Const KEYWORD As String = "ﾋﾟﾗﾐｯﾄﾞ"
 Const ROW_OFFSET_MARK As Long = -1

 Dim ws As Worksheet
 Dim lEndRow As Long
 Dim lSearchCol As Long
 Dim lMarkColStar As Long
 Dim lMarkColCircle As Long
 Dim lBlockBeginRow As Long
 Dim lBlockEndRow As Long
 Dim sValue As String
 Dim i As Long
 Dim lTargetRow As Long

 Set ws = ThisWorkbook.Worksheets(TARGET_SHEET_NAME)

 lSearchCol = ws.Columns(SEARCH_COL).Column
 lMarkColStar = ws.Columns(MARK_COL_STAR).Column
 lMarkColCircle = ws.Columns(MARK_COL_CIRCLE).Column

 lEndRow = ws.Cells(ws.Rows.Count, lSearchCol).End(xlUp).Row

 lBlockBeginRow = BEGIN_ROW

 Do
 If ws.Cells(lBlockBeginRow + 1, lSearchCol).Value <> "" Then
 lBlockEndRow = ws.Cells(lBlockBeginRow, lSearchCol).End(xlDown).Row
 Else
 lBlockEndRow = lBlockBeginRow
 End If

 For lTargetRow = lBlockBeginRow To lBlockEndRow
 If ws.Cells(lTargetRow, lSearchCol).Value Like "*" & KEYWORD & "*" Then
 ws.Cells(lTargetRow + ROW_OFFSET_MARK, lMarkColStar).Value = MARK_STAR
 ws.Cells(lTargetRow + ROW_OFFSET_MARK, lMarkColCircle).Value = MARK_CIRCLE

 Exit For
 End If

 DoEvents
 Next lTargetRow

 lBlockBeginRow = ws.Cells(lBlockEndRow, lSearchCol).End(xlDown).Row
 Loop Until lBlockBeginRow > lEndRow

 Set ws = Nothing

 Debug.Print "Done."

End Sub