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

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

ただいまの
回答率

88.60%

【マクロ】特定の列にて、ある単語から始まるデータを抽出したいです。

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 5,132

Gunjirk

score 23

 前提・実現したいこと

こんにちは。
Excelのマクロを作成中です。
初心者で調べても全くわからないので、ご教授ください。

P列の「sudo」という単語から始まるデータのみを抽出して、別のExcelファイルにコピーして貼り付けるコードを教えていただきたいです。
業務で、ある列のデータのみを抽出する必要があるのですが、ネットでもやり方がわかりません。

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

コードがわからない。

 該当のソースコード

なし

 試したこと

オートフィルター機能も試してみましたが、特定の列のデータのみ抽出するやり方がわかりません。

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

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

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

  • 退会済みユーザー

    2018/02/06 10:59

    複数のユーザーから「やってほしいことだけを記載した丸投げの質問」という意見がありました
    「質問を編集する」ボタンから編集を行い、調査したこと・試したことを記入していただくと、回答が得られやすくなります。

回答 2

checkベストアンサー

+4

オートフィルタを使った手作業でもよいなら、検索ボックスにsudo*と入れれば対象のもののみ抽出されます。

追記
不本意ですが基本的なコードを載せておきます。

Dim wb As Workbook
Dim ws As Worksheet
Dim r As Long
Set wb = Workbooks.Add                     ' 新規に作る場合
'Set wb = Workbooks.Open "ブックファイル名"  ' 既存ブックを開く場合
Set ws = wb.Worksheets(1)                  ' 貼り付けたいシートを設定
r = 1                                      ' 貼り付け先の開始行
For Each c In Range("P:P")
    If Left(c, 4) = "sudo" Then
        ' A列にコピーしていく
        ws.Cells(r, 1).Value = c
        r = r + 1
    End If
Next

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/02/06 08:53

    arasiさん>
    うーん、書かなくても見ればわかると思うのですよ。
    わからないなら知識が不足しているだけだと思いますよ。
    逆に基本知識が足りないなら「標準モジュールにこのように書いたら動かなかった」や「どこに書けばいいですか?」とか聞いてくれればいいのにと思います。

    キャンセル

  • 2018/02/06 09:21 編集

    私の基本知識が足りませんでした。ごめんね

    キャンセル

  • 2018/02/06 09:40

    ttyp03さん
    シートモジュールに書いたらうまくできました!!
    ずっとできなかったことができて、とても嬉しかったです!

    また、モジュールに種類があるとも知らずに、手間を取らせてしまい申し訳ございませんでした。
    今回の質問のおかげで、たくさん勉強できました。
    本当にありがとうございます。

    皆様もコメントにてたくさん議論してくださりありがとうございました。
    一人でネットで調べるよりも有意義な経験ができました。

    キャンセル

+2

最初だけ新規ブックに貼り付けをして、二回目以降はその一回目に新規作成したブックに貼り付けるようにするには、どうすればよいでしょうか。

とのことですので、抽出結果.xlsファイルを作成するならこんな感じかなと思います。初心者様ということで、コメントいっぱいつけておきますので今後の足しにしてください。拡張子やファイル名は適当に変更してください。

Sub addcopy_v2()

'抽出結果ファイルの名前を設定しています。2007以降であれば.xlsxとか使えますね。

Const SaveName As String = "抽出結果.xls"

'↓ここからはこれから使う変数を宣言してます。名称で何となく用途は想像してください。これは書いた人が勝手に決めます。
'といっても何となく想像できる名前にしてあげることが大事です。ほかの人も使うことを考えると・・・。
'私も得意ではないが・・・

Dim BaseWB As Workbook
Dim BaseWS As Worksheet
Dim WriteWB As Workbook
Dim WriteSheet As Worksheet
Dim CheckRange As Range
Dim RangeBuf As Range
Dim LastRow As Long
Dim FSO As Object

'ファイル探す為に、Scripting.FileSystemObjectオブジェクトを使います。
'ほかにも方法はあると思いますが、慣れておいたほうがいいです。
'参照設定(Microsoft scripting runtime)が必要な書き方。
'Dim FSO As New Scripting.FileSystemObject

'参照設定したくないならこの宣言
Set FSO = CreateObject("Scripting.FileSystemObject")

'検索対象のP列があるシート捕捉します。thisWorkbookは常にモジュール実行中(このコードが書いてあるほう)のブックを指します。そのワークシートインデックスが1のシートを捕捉。つまりBaseWbって分かりやすいように自分で決めた変数に格納して、後で色々いじくってやろうって魂胆です。
Set BaseWS = ThisWorkbook.Worksheets(1)

'上記で捕捉したBaseWSを使って、BaseWS.Range("P:P")と書くと、ThisWorkbook.Worksheets(1).Range("P:P")と同じ意味になります。
'オブジェクトは階層を持っています。アプリケーション→ブック→シート→レンジって感じです。
'辿るように操作したいセルにたどり着ければほぼ目的は達成できます。

'↓heckRangeという変数に捕捉したワークブックのレンジを格納します。
Set CheckRange = BaseWS.Range("P:P")

'ご希望通り、2回目は追記(?)もしくは上書き動作になるように。抽出結果ファイルを自分と同じディレクトリで探します
If FSO.FileExists(ThisWorkbook.Path & "\" & SaveName) = True Then

   'もしあればそのブックを開きます
   Set WriteWB = Workbooks.Open(ThisWorkbook.Path & "\" & SaveName)

   'sheet1を捕捉します。
   Set WriteSheet = WriteWB.Worksheets(1)
Else
   'なければ新規ブックを作成します
   Set WriteWB = Workbooks.Add

   'ActiveSheetを補足します。新規作成時においてsheet1を捕捉することになります。
   Set WriteSheet = ActiveSheet
End If

'上記の処理で捕捉した抽出シートの最終行を探します。
LastRow = WriteSheet.Cells(Rows.Count, 1).End(xlUp).Row
If LastRow <> 1 Then LastRow = LastRow + 1

'上書きならここで何らかの削除処理(シートごと消すのか、最終行から範囲を割り出して消すのか)今回は後者を書いておきます。
'必要であればコメントを解除してください
'=========================
'With WriteSheet
'   .Range(.Cells(1, 1), .Cells(LastRow, 1)).ClearContents
'End With
'   LastRow = 1
'=========================

'検索対象のP列があるシートの親、つまりブックをアクティブにします
BaseWS.Parent.Activate

'検索範囲をループします。
For Each RangeBuf In CheckRange

   'もし検索中のセルの先頭の4文字が"sudo"だったら、抽出シートの最終行に書き込みます。
   If Left(RangeBuf.Value, 4) = "sudo" Then
      WriteSheet.Cells(LastRow, 1).Value = RangeBuf.Value

      '書き込み位置を次の位置にずらします。
      LastRow = LastRow + 1
   End If

Next RangeBuf

'保存しますか?的なメッセージを止めます。
Application.DisplayAlerts = False
WriteWB.SaveAs Filename:=ThisWorkbook.Path & "\" & SaveName
WriteWB.Activate

'保存しますか?的なメッセージを止めたのを元に戻します。処理実行後のアプリケーションの動作に影響が残るからです。
Application.DisplayAlerts = True

End Sub

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/02/06 12:18

    ご返信と励ましのお言葉ありがとうございます!
    自分の成長のために、teratailをどんどん活用していきたいと思います!
    今後とも宜しくお願い致します。

    キャンセル

  • 2018/02/06 12:21

    あ、ちなみに+1消すだけだと、二回目の実行結果が前回とかぶります。
    lastrowが1以外だったら+1とするif文を追加するのが簡単かもしれません。

    キャンセル

  • 2018/02/06 13:13

    ご回答の修正までしていただき、ありがとうございます!

    キャンセル

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

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

関連した質問

同じタグがついた質問を見る