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

Excelで連続して固まっているデータ毎に、指定の10個のキーワードでそれぞれ置換したい

今、Sheet1のG列のセルに、10万行ほどデータが入っています(空白セル含む)。
例えば「りんご」「りんご (銘柄名)」や、「牛肉」「牛肉 (銘柄名)」などです。

G列を見ると「りんご」を含むセルは、?3?8行目、?23?45行目・・・53000?53211行目など、規則性なく並んでます。

そして「牛肉」を含むセルは、?11・12行目、?35?45行目・・・72345?72600行目など、これまた規則性はありません。
この状況におきまして。

“りんご”というフレーズが出てきまして、それが連続してかたまりになっておりましたら。(?の状況)
それを、Sheet2のB2セルにある文字列「りんご 赤い」に、全て置換してほしいのです。
8行目までが置換されまして、9行目に空白セルがあれば、一旦リセットしていただいて。

さらにG列を進んでいき、また“りんご”を含むフレーズが出てきます。(?の状況)
そしたら今度はSheet2のC2セルにある文字列「りんご フルーツ」に、全て置換してほしいのです。

1522512207
●拡大する

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

▽最新の回答へ

質問者から

(書ききれなかった質問の続きです)

45行目まで置換されまして、46行目に空白セルがあれば、またリセットし。
この流れを、Sheet2のK2セルまで、つまり、10個のキーワードで“りんご”を、固まりごとに置換したいのです。

K2セルまで完了しましたら“りんご”は終了で。
次にA3セル“牛肉”の置換を行い、同様にK3セルまで完了すれば。
A4セルのキーワード、Sheet1・G列を探して、B4?K4セルの文字列で置換、終わったらA5列のキーワード…と、この処理を続けたいのです。

判りにくい質問で恐縮です。空白セルが区切りとなり、うまくマクロ等で固まりごとに指定のキーワードで効率的に置換できたらありがたいのですが…可能でしたらご回答いただけますと助かります。
よろしくお願い致します<m(__)m>


1 ● Z1000S
●2800ポイント ベストアンサー

こんな感じですかね。

10万件のデータが無いので、どの程度のレスポンスになるかわかりませんが・・・

'置換対象データ関連
Private Const TARGET_SHEET_NAME As String = "Sheet1"

'フィルターの基準となる列(G列)
Private Const TARGET_COL As Long = 7


'キーワード関連
Private Const KEYWORDS_SHEET_NAME As String = "Sheet2"

Private Const KEYWORDS_BEGIN_ROW As Long = 2

Private Const MAIN_KEYWORDS_COL As Long = 1

Private Const REPLACE_WORDS_BEGIN_COL As Long = 2

Private Const REPLACE_WORDS_COUNT As Long = 10


Public Sub replaceCellsMain()

 Dim wsKeywords As Worksheet
 Dim wsTarget As Worksheet
 Dim lKeywordsCount As Long
 Dim sReplaceWords(REPLACE_WORDS_COUNT - 1) As String
 Dim sMainKeywords As String
 Dim lTargetRows() As Long
 Dim lTargetRowsCount As Long
 Dim i As Long

 Application.ScreenUpdating = False

 Set wsTarget = ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
 Set wsKeywords = ThisWorkbook.Worksheets(KEYWORDS_SHEET_NAME)

  '置換するキーワード数取得
 lKeywordsCount = getKeywordsCount(wsKeywords)

 For i = 0 To lKeywordsCount - 1
  '置換するキーワードと置換後の文字列取得
 sMainKeywords = getKeywords(wsKeywords, i, sReplaceWords)

  'キーワードが含まれる行を格納する配列の初期化
 ReDim lTargetRow(0)

  'キーワードが含まれる行の取得
 lTargetRowsCount = getTargetRows(wsTarget, sMainKeywords, lTargetRows)

 If lTargetRowsCount > 0 Then
  '置換
 Call replaceCells(wsTarget, sMainKeywords, lTargetRows, sReplaceWords)
 End If

 Debug.Print sMainKeywords & " Done."
 Next i

 Set wsKeywords = Nothing
 Set wsTarget = Nothing

 Application.ScreenUpdating = True

End Sub

Private Function getKeywordsCount(ByRef ws As Worksheet) As Long

 Dim lEndRow As Long

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

 getKeywordsCount = lEndRow - KEYWORDS_BEGIN_ROW + 1

End Function

Private Function getKeywords(ByRef ws As Worksheet, ByVal lIndex As Long, ByRef sKeywords() As String) As String

 Dim i As Long

 For i = 0 To REPLACE_WORDS_COUNT - 1
 sKeywords(i) = ws.Cells(KEYWORDS_BEGIN_ROW + lIndex, REPLACE_WORDS_BEGIN_COL + i).Value
 Next i

 getKeywords = ws.Cells(KEYWORDS_BEGIN_ROW + lIndex, MAIN_KEYWORDS_COL).Value

End Function

Private Function getTargetRows(ByRef ws As Worksheet, ByVal sKeyword As String, ByRef lTargetRows() As Long) As Long

 Dim xlFilterRow As Range
 Dim lHeaderRow As Long
 Dim lEndRow As Long
 Dim lTargetCounts As Long
 Dim lCount As Long

 With ws
  'オートフィルタの設定状態
 If .AutoFilterMode = True Then
  'オートフィルタが設定済みなら、一旦解除
 .AutoFilter.Range.AutoFilter
 End If

  'オートフィルタのヘッダとなるダミー行を挿入
 .Rows(1).Insert
 lHeaderRow = 1
 .Cells(lHeaderRow, TARGET_COL).Value = "DummyHeader"

  '終了行
 lEndRow = .Cells(.Rows.Count, TARGET_COL).End(xlUp).Row

  '指定文字データを抽出
 With .Range(.Cells(1, TARGET_COL), .Cells(lEndRow, TARGET_COL))
  'オートフィルタ実行
 .AutoFilter Field:=1, Criteria1:="=*" & sKeyword & "*"

  '絞り込まれた件数取得(ヘッダー行が含まれているため補正)
 lTargetCounts = .SpecialCells(xlCellTypeVisible).Count - lHeaderRow

 If lTargetCounts > 0 Then
  '対象の行を格納する配列初期化
 ReDim lTargetRows(lTargetCounts - 1)

 For Each xlFilterRow In .SpecialCells(xlVisible)
  '対象データの行の取得
 If xlFilterRow.Row > lHeaderRow Then
  'ヘッダー行以降
 lTargetRows(lCount) = xlFilterRow.Row - lHeaderRow

 lCount = lCount + 1
 End If
 Next xlFilterRow
 End If
 End With

  'オートフィルタ解除
 .AutoFilter.Range.AutoFilter

  'ダミーヘッダー行削除
 .Rows(1).Delete
 End With

 getTargetRows = lTargetCounts

End Function

Private Sub replaceCells(ByRef wsTarget As Worksheet, ByVal sMainKeywords As String, ByRef lTargetRows() As Long, ByRef sReplaceWords() As String)

 Dim lBeginRow As Long
 Dim lEndRow As Long
 Dim lTargetIndex As Long
 Dim lTargetCount As Long
 Dim lReplaceIndex As Long
 Dim i As Long

 lTargetIndex = 0
 lReplaceIndex = 0

 Do Until (lTargetIndex > UBound(lTargetRows)) Or (lReplaceIndex > UBound(sReplaceWords))
 lBeginRow = lTargetRows(lTargetIndex)

 lEndRow = lBeginRow

 lTargetCount = 1

  '値の連続した最終行を取得
 For i = 1 To UBound(lTargetRows) - lTargetIndex
 If lTargetRows(lTargetIndex + i) = lEndRow + 1 Then
 lEndRow = lEndRow + 1

 lTargetCount = lTargetCount + 1
 Else
 Exit For
 End If
 Next i

  '2行以上連続していたら置換
 If lEndRow > lBeginRow Then
 With wsTarget
  '置換
 .Range(.Cells(lBeginRow, TARGET_COL), .Cells(lEndRow, TARGET_COL)).Replace What:=sMainKeywords, Replacement:=sReplaceWords(lReplaceIndex), LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False
 End With

 lTargetIndex = lTargetIndex + lTargetCount

 lReplaceIndex = lReplaceIndex + 1
 Else
 lTargetIndex = lTargetIndex + 1
 End If
 Loop

End Sub

moon-fonduさんのコメント
Z1000Sさんありがとうございます。 すごいです、すぐに置換できました。 しかし問題が生じまして、G列にありますデータ、 例えば“りんご”を“りんご 赤い”に置換した際、 りんご 赤い りんご 赤い りんご 赤い と、全て「りんご 赤い」になってしまいまして。 後ろにくっつていおります文字列も残しまして、 りんご 赤い りんご 赤い ジョナゴールド りんご 赤い ふじ りんご 赤い 紅花 ・ ・ ・ のようにしたいのですが。 もし可能でしたら再度お教えいただけますとありがたいです。 よろしくお願い致します<m(__)m>

Z1000Sさんのコメント
コードを一部変更しました。 ご要望の動作となりますでしょうか? ちなみに、 >> “りんご”というフレーズが出てきまして、それが連続してかたまりになっておりましたら。(?の状況) << とありますが、連続せずに1行だけの行はあるのでしょうか? 提示したコードでは、1行だけの場合、連続していないので 置換対象外としてスキップしています。

moon-fonduさんのコメント
ありがとうございます、理想通りに置換することができました(^^; 1行だけのデータはありませんので、問題ありません。 ただもし、可能であればお答えいただきたいのですが…今回はB?Kのセル、10個のキーワードで置換していただいたのですが。 仮にZまで(26個)ある場合や、AHまで(34個)ある場合など、置換するキーワードの数を変更したい場合などは。 Z1000Sさんが書いていただいたマクロの、どの部分を修正すればよろしいでしょうか? お手隙の時にご回答いただけますと幸いです。

Z1000Sさんのコメント
うまく動作してくれたようで、何よりです。 >> ただもし、可能であればお答えいただきたいのですが << 今回のように、すべてのキーワードに対する置換文字列の数が固定(同じ)であるならば可能です。 >|vb| Private Const REPLACE_WORDS_COUNT As Long = 10 ||< の10の部分を変えて下さい。 ただし、キーワード毎に数が違うというのであれば 別の方法を取る必要があります。(試してませんが、多分出来るでしょう) それについては、ここですぐにコードを提示出来るようなものではありませんので、ご了承下さい。 もしどうしても、そのような処理が必要なのであれば、 新たな質問として投稿された方がよいかと思います。 では、頑張って下さい。

Z1000Sさんのコメント
「ベストアンサー」ありがとうございます。

2 ● Asayuri
●200ポイント

エクセルの関数式でファイルを作成してみました。

T列をコピーしてG列に値貼付けすれば ご希望のデータが出来上がります。

ご確認ください。よろしくお願いいたします。

次のURLからダウンロードしてください。
http://firestorage.jp/download/920a275b7ad1370e705933e185b51851aaa22e84


moon-fonduさんのコメント
Asayuriさんありがとうございます。 実はG列で置換したいデータは“りんご” という文字列単体ではなく、“りんご ふじ A”や“りんご ふじ C”など、 半角スペース混じりの複合ワードであったりします。 “りんご ふじ”というワードを“りんご 赤い”に置換するとともに。 後ろの文字列は生かしたいのです。 上記の例でいいますと、“りんご ふじ”を“りんご 赤い”に置換し、 “りんご 赤い A” “りんご 赤い C” のように、くっついている“A”や“C”の文字列はそのままにしておきたいのです。 もし半角スペース混じりの文字列の置換が可能であれば、再度お教えいただけますと幸いです。 質問が判りにくくすみません(-_-;)

Asayuriさんのコメント
質問文章の意味することを理解することができません 質問内容を整理して、言葉表現を 再考していただきたいです。 完成前と要求している完成後の画像を 張り付けてください。 完成イメージ画像のほうがよく伝わるでしょう。 よろしくお願いします。

moon-fonduさんのコメント
失礼しました、わかりにくくてすみません(;^_^ こちらが完成前 http://f.hatena.ne.jp/moon-fondu/20180402210144 で。 こちらが完成後 http://f.hatena.ne.jp/moon-fondu/20180402210147 です。

Asayuriさんのコメント
完成前と 完成後イメージ画像で 空白行や 牛肉行は どこにあって どう変化させたいのでしょうか?
関連質問

●質問をもっと探す●



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