質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.10%

Excel VBAで特定の文字(記号)を含むセルのみを抽出し、それを別シートに表示したい

解決済

回答 4

投稿

  • 評価
  • クリップ 0
  • VIEW 7,542

odanngo_taifu

score 16

前提・実現したいこと

Excel VBAを使用しています。
Sheet1には
![イメージ説明]
↑このような文字列がセルに入力されています。
このうち、文字列に『→』を含むセルのみを別ブックのSheet2に表示させたいです。
例えば上に貼付致しました画像の場合ですと、Sheet2に
イメージ説明
↑このように一括表示させたいです。
「d→e」が入力してあるCells(1,2)は1行目の2列目、「j→k」が入力してあるCells(3,3)は3行目の3列目なのでこのような表示になります。

手順といたしましては
①行番号と列番号をそれぞれ(i,j)と置きRange("A1","C3")のセルを一括で取得
②「→」を含むセル番号をSheet2に一括表示

という流れになるのかな...と思いましたが、それをコードで表すことができず悩んでおります。
もしわかる方がいらっしゃいましたらアドバイスなどよろしくお願い致します。

発生している問題・エラーメッセージ

該当のソースコード

ExcelVBA

試したこと

補足情報(FW/ツールのバージョンなど)

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • aki.aki.

    2019/03/04 22:12

    VBAのコードを書いたことがありますか?1行でもいいので、コードを書きましょう。場合によっては、時間に余裕のある方が、教えてくれるかも知れませんが、ここで教わるには無理があります。

    キャンセル

回答 4

+5

やりたいことに対して手順をざっくりと捉えすぎていることが「コードで表すことができない」原因だと思います。
もう少し掘り下げたいところですね。

特に「一括で取得」「一括表示」というあたりに問題がありそうだと感じました。

必要な情報をごちゃっと渡せばこちらの都合のいい形で結果を返してくれる関数など、ほとんどの場合ありません。
ないから自分でコーディングするんですよね。

やりたいことをひとつひとつ積み上げて形にしていくのがコーディングです。


今回の場合、「一括処理」とイメージしている部分を「対象セルひとつひとつに、同じ処理を繰り返す」と考えてみてはどうでしょうか。

① Range("A1:C3")のセル範囲からセルを1つずつ取り出すループ処理
② 取り出したセルに「→」が含まれているか判定(InStr関数、IF文)
③-a 「→」が含まれている場合、対象セルの行番号と列番号を取得し、Sheet2の各セルに出力。(Sheet2の何行目に出力するのかも制御しないとですね。Range.End(xlUp)など。)
③-b 「→」が含まれていない場合、特に処理しない
④ ②~③を取り出すセルがなくなるまで繰り返す

こうなると、ひとつひとつのセルに対する処理ではそんなに難しいキーワードはでてこなくなるのではないでしょうか?

例えば①なら

For Each c In Sheet1.Range("A1:C3")     '←①
    Msgbox c.Row & "," & c.Column       '←③aのヒント
Next                                    '←④


でセル範囲からセルを1つずつ取り出すループ処理ができます

②はIf文とInstr関数を組み合わせれば取り出したセルの文字に「→」が含まれるかチェックできます。

他の方のアドバイスも参考に、まずは作ってみてください。


ちなみに、対象のセル範囲に対してFind関数で検索をする方法もあります。
この場合、検索結果が見つかれば1セルずつ返されるので、検索が見つかる限り繰り返し処理するループ処理を作ることになります。

こちらの方がループ回数は少なくなりますが、少し高度なコーディングになりますね。

今回は対象セル数も少ないので、まずはInstr関数での検索でいいと思います。
とりあえず手を動かしてがんばってみてください。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/05 11:03

    さすがです!初心者の方にはこういう手ほどきが必要なんですよね。すじ道を理解できれば、加速度的に進歩すると思うのです。

    私も勉強させて頂きました。ありがとうございます!

    キャンセル

  • 2019/03/09 14:15

    分かりやすくご説明していただき、ありがとうございました!
    まずは問題文から処理手順をしっかりと掘り下げることを怠らず、一つずつ取り組んでいこうと思います。

    キャンセル

checkベストアンサー

+3

For Each と、InStr と、Offset を使いました。

シート(Sheet2) の、見出しは1行目、行列値の書き込みが2行目からだとして
データ上書きの例と、データ追記の例を貼りましたので参考にしてみて下さい。

見出し行などの条件が変わると期待するセルに書き込んでくれません。
書き直してみて下さい。
データ追記の例で使った End(xlUP) は、キーボードの 「End」「↓」「↑」 です。

Dim Rng As Range
Dim r As Integer

For Each Rng In Sheets("Sheet1").Range("A1:C3")
    If InStr(Rng.Value, "→") > 0 Then
        With Sheets("Sheet2")
            .Range("A2").Offset(r).Value = Rng.Row
            .Range("B2").Offset(r).Value = Rng.Column
        End With
        r = r + 1
    End If
Next Rng
Dim Rng As Range
Dim r As Integer

r = Cells(Rows.Count, 1).End(xlUp).Row

For Each Rng In Sheets("Sheet1").Range("A1:C3")
    If InStr(Rng.Value, "→") > 0 Then
        With Sheets("Sheet2")
            .Range("A1").Offset(r).Value = Rng.Row
            .Range("B1").Offset(r).Value = Rng.Column
        End With
        r = r + 1
    End If
Next Rng

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/09 14:03

    無事解決致しました。一つ一つ文法の意味を確認することもでき、大変勉強になりました。
    ありがとうございました!

    キャンセル

+3

既に回答がありますが、一応odanngo_taifuさんのお勉強の為に別の方法を。
1.Cellsを使うと、列番号、行番号でセルにアクセスできます。
2.Selectionを使うと、アクティブシートのセレクトされたセルの集合を表します。
つまりどこを選択した状態でも、プログラムコードに依存しない作りが可能です。

Sub hogehoge()
    Dim intcol As Integer: intcol = 1
    Dim introw As Integer: introw = 1
    Dim cellpoint As Range
    For Each cellpoint In Selection
        If (InStr(cellpoint.Value, "→") <> 0) Then
            Worksheets(2).Cells(introw, intcol).Value = cellpoint.Row
            Worksheets(2).Cells(introw, intcol + 1).Value = cellpoint.Column
            introw = introw + 1
        End If
    Next cellpoint
    Range("A1").Select
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/05 10:24 編集

    「検査の対象を"A1:C3"以外にしたい場合、この方法ならシート上で選択した範囲が検査の対象となりますよ」
    ということですね。

    出力座標指定に関しては、私も基準セルに対するOffsetよりCellsのほうが直感的でわかりやすいと思います。

    キャンセル

  • 2019/03/09 14:08

    無事解決致しました。分かりやすく教えていただき、大変勉強になりました。
    ありがとうございました!

    キャンセル

+1

Sub test()
    Const cMyKye As String = "*→*"
    Dim rngTable As Range
    Dim rngTarget As Range
    Dim c As Range
    Dim ixRow As Long

    ThisWorkbook.Worksheets("Sheet1").Copy

    Set rngTable = Workbooks(Workbooks.Count).Worksheets(1).Range("A1").CurrentRegion
    rngTable.Replace cMyKye, ""
    On Error Resume Next
    Set rngTarget = rngTable.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If rngTarget Is Nothing Then Exit Sub

    ixRow = 2
    With ThisWorkbook.Worksheets("Sheet2").Cells
        For Each c In rngTarget
            .Item(ixRow, 1).Value = c.Row
            .Item(ixRow, 2).Value = c.Column
            ixRow = ixRow + 1
        Next
    End With

    rngTable.Worksheet.Parent.Close False
End Sub

遊びで別案。
置換機能で空白にし、ジャンプ機能で検索するようにしてみました。
参考になれば。。。(セルを読む量を減らしてみたけど、速度的には不明。)

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/09 14:18

    教えていただきありがとうございます!
    これから一つずつ調べて理解しようと思います...!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.10%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる