中小企業の働き方改革をサポート>>

VBA勉強中のため、力を貸していただけますと助かります。

日次で吐き出されるcsvデータをexcelブックに読み込み、条件によって抽出、シートに反映させるまでを自動化したいのですが、どのようにコードを組めばよいのかご教授いただけないでしょうか。

元データ(csv)
A列 B列 C列 D列
日付 担当者名 案件名 価格

反映ブック(excel)
※ブックにはcsvの担当者名ごとにシートがあります。

A列 B列 C列 D列 E列 F列
日付 案件名 価格 計上数【A】 計上数【P】 計上数【H】

反映させたいこと
① 元データの担当者名(B列)をexcelブックにある同じ担当者名シートに反映させたい
-1.反映させる内容は「日付」A列と「案件名」B列

②案件名の頭文字に【A】が付いているものは、D列の「計上数【A】」セルに「1」(数値)を入力させる。
同じように、案件名の頭文字に【P】が付いているものは、E列の「計上数【P】」セルに「1」(数値)を入力させる。
案件名の頭文字に【H】が付いているものは、F列の「計上数【H】」セルに「1」(数値)を入力させる。

※担当者は40名程度おり、日次のデータ数としまして200〜300ありますため、なんとか自動化したいです。

どうぞよろしくお願いいたします。

質問者からの補足コメント

  • 早速おしえてくださり、ありがとうございます。
    ですが、現在教えていただいたフローとほぼ等しい作業を行っており工数的に負担ですため、簡略化したいと思っております。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/12/08 19:24
  • ありがとうございます。
    お答えいたします。

    ①〜④
    元データのcsvを反映ブックのシートに貼り付けるまではマンパワーでもかまわないと思っています。
    ですので、反映ブックにデータ用シート(仮)を用意してそこから自動抽出反映を行いたいです。

    ⑤ VBAのコードは反映ブックに有るとして考えて良いのでしょうか?

    上記のルール決めにしたいのでコードは反映ブックにお願いいたします

    ⑥ 二重取り込んでしまったときは「日付」「案件名」「価格」をキーにして削除は可能でしょうか?

    削除可能です。

    何卒よろしくお願いいたします

    No.2の回答に寄せられた補足コメントです。 補足日時:2017/12/08 19:33
  • お返事が遅くなり申し訳ございませんでした
    教えてくださったcodeを使用しようと試みたのですが
    私の説明不足できちんと動きませんでした
    恐らく、反映させたいセルの位置が違うことや、実行ファイルが違っていたのかもしれません。
    添付画像のようなシート内構成です

    アポ一覧というシートが元データです。
    反映したいシートは担当者の名前分あります。

    こういった構成で、アポ一覧シートからマクロ実行を行いたいです。

    何卒、宜しくお願い致します。

    「教えて下さい!データの自動抽出反映をマク」の補足画像3
    No.3の回答に寄せられた補足コメントです。 補足日時:2017/12/09 17:50
  • 添付のように
    インデックスエラーになってしまいます。

    先ほどの添付ファイルのように
    インデックスのセルが5行目だからでしょうか

    「教えて下さい!データの自動抽出反映をマク」の補足画像4
    No.4の回答に寄せられた補足コメントです。 補足日時:2017/12/09 18:21
  • 何度も申し訳ございません。
    実行時にエラーになるデバック表示は
    添付のとおりです。

    また
    頭文字は【A】【P】【H】で間違いありません

    お願いいたします

    「教えて下さい!データの自動抽出反映をマク」の補足画像5
    No.5の回答に寄せられた補足コメントです。 補足日時:2017/12/09 18:33
  • シートのタブ構成も添付します。
    何卒、宜しくお願い致します。

    「教えて下さい!データの自動抽出反映をマク」の補足画像6
      補足日時:2017/12/09 18:37
  • No.6 の訂正はなしでよろしいでしょうか。
    それとも、そもそもそのcodeは必要ないのでしょうか

    アポ一覧の一は漢数字で間違いございません。

    No.8の回答に寄せられた補足コメントです。 補足日時:2017/12/09 19:13
  • 申し訳ございません。

    デバックで反転されるコードは
    With Sheets(Cells(元行, 2).Value)
    上記の部分です

    反映させるためのシート名に問題があるのでしょうか。

    インデックスが有効範囲にありません (エラー 9)

    という表示が、そもそもないものを参照して起きてしまっているのかなと思ったのですが・・・

    No.10の回答に寄せられた補足コメントです。 補足日時:2017/12/09 19:56
  • >>アポ一覧シートのその行のB列の値(担当者名)のシートは存在しますか?
    「元行=2」と表示され、その担当者名のシートはありませんでした。

    >>担当者のシートが存在しない場合は自動で追加する事ももちろん出来ます。必要ですか?
    はい、ぜひ追加をお願いしたいです。

    No.12の回答に寄せられた補足コメントです。 補足日時:2017/12/09 20:19

A 回答 (13件中11~13件)

300件位ならば以下のようなもので良いかと…


--------------------------------------------------------------------------------
Sub Sample()
Const 元データシート名 As String = "元データ"
Dim 元行 As Long
Dim 先行 As Long
Sheets(元データシート名).Select
For 元行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
With Sheets(Cells(元行, 2).Value)
先行 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(先行, 1).Value = Cells(元行, 1).Value
.Cells(先行, 2).Value = Cells(元行, 3).Value
.Cells(先行, 3).Value = Cells(元行, 4).Value
Select Case Left(Cells(元行, 3).Value, 2)
Case "【A"
.Cells(先行, 4).Value = 1
Case "【P"
.Cells(先行, 5).Value = 1
Case "【H"
.Cells(先行, 6).Value = 1
End Select
End With
Next
End Sub
--------------------------------------------------------------------------------
※ 元データの有るシート名に合わせて「Const 元データシート名 As String = "元データ"」を修正してください。
この回答への補足あり
    • good
    • 0

いくつか確認したいことが有ります


① 元データは「,」区切りでしょうか?
② 元データにはタイトル行はありますか?
③ 元データと反映ブックは同じフォルダーに有るのでしょうか?
④ 元データの指定はどうするのでしょうか?
⑤ VBAのコードは反映ブックに有るとして考えて良いのでしょうか?
⑥ 二重取り込んでしまったときは「日付」「案件名」「価格」をキーにして削除は可能でしょうか?
この回答への補足あり
    • good
    • 0

>どのようにコードを組めばよいのかご教授いただけないでしょうか。


CSVは名前でフィルターしたら
そのまま一時的なシートにコピペしたらどうかな。

でその一時的シートの右方向のセルに関数で②の整形を
させておけば、それを各自のシートに貼るだけだから
名前の分フィルターをループさせながら
コピペを繰り返すだけで
そんな難しくないコードになるんじゃないでしょうか?
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QEXCEL VBA データを抽出して別シートへ貼り付ける方法

お世話になります。以下の例のように
元のデータを 品名ごとの別シートに 日付順に並べて 貼り付けられるように
したいのですが、どのようにコードを組めばよいかご教授 頂けないでしょうか。



元データsheet
A列     B列    C列     D列
日付     品名        個数
2/1      りんご       50
2/13     みかん       150
3/22    りんご       75
2/10    りんご       100
3/13    みかん       120


抽出先りんごsheet
A列     B列    C列    D列
日付     品名    個数
2/1     りんご   50
2/10     りんご   100
3/22     りんご   75

よろしくお願い致します。

Aベストアンサー

VBA勉強中と云うことなので、「こんな方法もあるよ」的な回答をさせていただきます。
抽出元を抽出先にコピーして、そこから「りんご」以外を削除するロジックとなっています。
なお、抽出先のシートが存在していないとエラーになります。また、抽出対象の「りんご」が無い場合も、エラーになりますので、必要であれば、notimeさんの方で組み込んでください(勉強の一環として)。

Sub りんご()
Dim ToWs As Worksheet
Dim DifRng As Range
Set ToWs = Worksheets("抽出先りんごsheet")
Worksheets("元データsheet").Columns("A:D").Copy Destination:=ToWs.Columns("A:D")
ToWs.Columns("C").Delete
With ToWs.Range("B2:B" & Rows.Count)
Set DifRng = .Find(What:="りんご", LookIn:=xlFormulas, LookAt:=xlPart)
.ColumnDifferences(DifRng).EntireRow.Delete
End With
ToWs.Range("A:C").Sort key1:=ToWs.Range("A1"), order1:=xlAscending, Header:=xlYes
End Sub

VBA勉強中と云うことなので、「こんな方法もあるよ」的な回答をさせていただきます。
抽出元を抽出先にコピーして、そこから「りんご」以外を削除するロジックとなっています。
なお、抽出先のシートが存在していないとエラーになります。また、抽出対象の「りんご」が無い場合も、エラーになりますので、必要であれば、notimeさんの方で組み込んでください(勉強の一環として)。

Sub りんご()
Dim ToWs As Worksheet
Dim DifRng As Range
Set ToWs = Worksheets("抽出先りんごsheet")
Workshee...続きを読む


人気Q&Aランキング

おすすめ情報