人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

連続して固まっているデータ毎に、指定のキーワードが文字列に含まれていたら、上に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列)を入れたいのです。

●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

質問者から

このケースの場合は、41行目と87行目のM列・N列に★・●が入ることになり、そういった処理を10万行ほど行いたいです。

データを固まりとして扱う点でこの質問 http://q.hatena.ne.jp/1522512207 や、移動させて貼り付けるという点でこの質問 http://q.hatena.ne.jp/1458539237 と似てる気もするのですが応用の方法が判らず…お教えいただけますと幸いです。
よろしくお願い致します。


1 ● a-kuma3
●1000ポイント ベストアンサー

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

moon-fonduさんのコメント
a-kuma3さんありがとうございます! すごいです、★と●が、打ち込まれました(^^;) でもすみません、データの固まりの、一番上に“ピラミッド”とある文字列だけを対象としたいのですが。 現状、実行させていただくと41?82行目、87?122行目のM・N列に★と●が入りました。 G列の42?83行目(?)、88?123行目(?)全てのセルに“ピラミッド”という文字列が入っているからなのかもしれません…41行目と87行目だけに入ると幸いなのですが。 度々お手数お掛けして申し訳ございませんが、お手隙の時にご教授いただけますと助かります<m(__)m>

a-kuma3さんのコメント
>> でもすみません、データの固まりの、一番上に“ピラミッド”とある文字列だけを対象としたいのですが。 << 回答に追記しました。

moon-fonduさんのコメント
ありがとうございます、うまく変換されました! ただ5?39行目(?)など、“ピラミッド”を含まない該当しない固まりのM・N列が、空白セルで上書きされてしまいまして。(?の場合は、4行目のM・N列が空白に) 該当しない固まりについては、データをそのままに残したいのですが…(^^;)

a-kuma3さんのコメント
>> 該当しない固まりについては、データをそのままに残したいのですが…(^^;) << あ、すみません。 M・N列を、最初に消すように書いてしまいました。 以下の行を削除してください。 >|vb| Range(Cells(2, 13), Cells(last_row, 14)).Clear ||<

a-kuma3さんのコメント
該当行を消したものがこちらになります。 >|vb| 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 ||<

moon-fonduさんのコメント
うまくいきました!何度もご回答いただきまして、ありがとうございました(^^;)

2 ● Z1000S
●1000ポイント

これで意図した結果になりますでしょうか?
行をフルスキャンしないようにしてあるので
その分は早いかと・・・

全ての行の文字列に“ピラミッド”という文字が何らかの形で入っています。

これを信用してよいのであれば、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

moon-fonduさんのコメント
ありがとうございます、うまく該当のM・N列に記号が入りました(^_^;)

3 ● Asayuri
●50ポイント


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列には お望みのマークが表示されます




moon-fonduさんのコメント
こういった方法もあるんですね、ご回答ありがとうございます(^^; ただこの方法ですと、まず元のM・N列にあったデータを消すわけにはいかずここに関数は入れられないので、新たに列を増やして入れることになります。 「ピラミッド」を含むセルから上に1セル、右に6セル移動したセルに★・●マークは出てくるのですが。 元データは変換されていないので、「出てきた★・●を、元はM・N列にあったけど列を増やした際に移動したセルに貼り付ける」という別の作業が必要なようです。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ