Excelの質問です。今、G列に文字列(半角スペースなど含む)がズラリと入ってるセル、何も入ってない空白セル併せて、10万行ぐらいあります。
最初のデータは5~39行目(①)、そして空白セルがあり、次のデータは42~83行目(②)、そして空白セル、その次は88~123行目(③)と、特に規則性はないですが、空白セルが出てきたら区切りとし、それぞれのデータを固まりとして考えます。
そして空白セル除くデータの固まりの中で、②と③の固まりには“ピラミッド”という文字列が入ってます。42~83行目、88~123行目、全ての行の文字列に“ピラミッド”という文字が何らかの形で入っています。
この状況におきまして。
データの固まりごとに、最初に“ピラミッド”と出てきたセルから上に1セル、右に6セル移動したM・N列のセルそれぞれに、★マーク(M列)と●マーク(N列)を入れたいのです。
このケースの場合は、41行目と87行目のM列・N列に★・●が入ることになり、そういった処理を10万行ほど行いたいです。
データを固まりとして扱う点でこの質問 http://q.hatena.ne.jp/1522512207 や、移動させて貼り付けるという点でこの質問 http://q.hatena.ne.jp/1458539237 と似てる気もするのですが応用の方法が判らず…お教えいただけますと幸いです。
よろしくお願い致します。
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
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
該当行を消したものがこちらになります。
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 = "ピラミッド" ' 検索する単語 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
ありがとうございます、うまく該当のM・N列に記号が入りました(^_^;)
K列の1行目に =IF(COUNTIF(G1,"*ピラミッド*"),1,0)
L列の1行目に =IF(K2-K1=1,1,"")
M列の1行目に =IF(L1=1,"★マーク","")
N列の1行目に =IF(L1=1,"●マーク","")
を入力してから 各行へコピー&ペーストします
M列とN列には お望みのマークが表示されます
こういった方法もあるんですね、ご回答ありがとうございます(^^;
ただこの方法ですと、まず元のM・N列にあったデータを消すわけにはいかずここに関数は入れられないので、新たに列を増やして入れることになります。
「ピラミッド」を含むセルから上に1セル、右に6セル移動したセルに★・●マークは出てくるのですが。
元データは変換されていないので、「出てきた★・●を、元はM・N列にあったけど列を増やした際に移動したセルに貼り付ける」という別の作業が必要なようです。
該当行を消したものがこちらになります。
2018/08/04 20:38:33うまくいきました!何度もご回答いただきまして、ありがとうございました(^^;)
2018/08/06 16:04:46