エクセル データを抜き出し帳票へ出力
- エクセルのバージョンは2007を使用しています。下記sheet1のようなデータがあるときに、sheet2に月ごとに集計し順位ごとにまとめてB列にまとめて記載する帳票を作りたい。
- 該当者がいなければB列には空白を返し、該当者がいる場合はB列に個人ごとにまとめ、名前、その月にその人がその順位をとった回数(1度のみの時は省略)、そして4月から積み重ねてその人がその順位をとった回数、その時の場所を記載します。
- エクセルの関数では難しい場合はVBAやマクロを使って自動化する方法も検討しています。どのプログラムを使えば自動化できるのかについても理解しておらず、どのプログラムを学んでいけばいいのかも分かりません。どのようにすれば実現できるか、ヒントやアドバイスを教えていただけると助かります。
- ベストアンサー
エクセル DBから該当データを抜き出し帳票へ出力
エクセルについて質問です。 エクセルのバージョンは2007を使用しています。 下記sheet1のようなデータがあるときに、sheet2に月ごとに集計し 順位ごとにまとめてB列にまとめて記載する帳票を作っているのですが (※ちなみにその形式を説明させていただきますと 該当者がいなければB列には空白を返し 該当者がいる場合はB列に個人ごとにまとめ、 (1)名前、(2)その月にその人がその順位をとった回数《1度のみの時は省略》、そして 括弧の中に(3)4月から積み重ねてその人がその順位をとった回数、(4)その時の場所 を記載し すべて半コンマ(,)プラス空白で区切ってB列の1セル内に羅列しております) これをsheet1にデータを入力すれば自動的にsheet2のB列に 今の形式で反映されるようにしたいのです。 エクセルの関数でできるならばもちろんその方法を知りたいのですが もし不可能であるならばVBA?マクロ?なども勉強して組んでいければと思っています。 今はどのプログラムを使えば自動化できるのかについても理解しておりませんので どのプログラムをどんなふうに学んでいけばいいのかさえ見当がつかずじまいの状態です。 これを使ってこうすればできるよ、という方法をご存知の方がいらっしゃいましたら そのさわりの部分、ヒントだけでもかまいませんので教えていただきたいのです。 どうかよろしくお願いいたします。 <sheet1> A B C 1 月 名前 成績 場所 2 4月 山田 1位 甲 3 4月 佐藤 2位 乙 4 5月 佐藤 2位 甲 5 5月 佐藤 2位 甲 6 5月 山田 3位 丙 7 5月 佐藤 4位 丁 8 5月 山田 2位 甲 <sheet2> A B 1 5月度成績 2 3 1位 空白 4 2位 佐藤2回(3, 甲, 甲), 山田(1, 甲) 5 3位 山田(1, 丙) 6 4位 佐藤(1, 丁)
- aquagraphics
- お礼率62% (5/8)
- その他MS Office製品
- 回答数2
- ありがとう数3
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
こんばんは! VBAで無理矢理やってみました。 条件として (1)Sheet2のA1セルにSheet1の「○月」というデータを入力する。 (2)Sheet2の順位(1位~)はA3セル以降に入力済み というコトが前提です。 画面左下のSheet2のSheet見出し上で右クリック → コードの表示 → VBE画面に ↓のコードをコピー&ペーストしてマクロを実行してみてください。 (Alt+F8キー → マクロ → マクロ実行です) Sub test() 'この行から Dim i, j, k, N, M As Long Dim str, buf As String Dim ws As Worksheet Set ws = Worksheets("Sheet1") k = Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = False On Error Resume Next If k > 2 Then Range(Cells(3, 2), Cells(k, 2)).ClearContents End If For k = 3 To Cells(Rows.Count, 1).End(xlUp).Row N = 2 For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row If ws.Cells(i, 1) = Cells(1, 1) And ws.Cells(i, 3) = Cells(k, 1) Then If WorksheetFunction.CountIf(Rows(k), ws.Cells(i, 2)) = 0 Then N = N + 1 Cells(k, N) = ws.Cells(i, 2) End If End If Next i Next k For k = 3 To Cells(Rows.Count, 3).End(xlUp).Row For j = 3 To Cells(k, Columns.Count).End(xlToLeft).Column str = Cells(k, j) M = 0 N = 0 For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row If ws.Cells(i, 1) = Cells(1, 1) And ws.Cells(i, 2) = str And ws.Cells(i, 3) = Cells(k, 1) Then M = M + 1 End If If ws.Cells(i, 2) = str And ws.Cells(i, 3) = Cells(k, 1) Then N = N + 1 If ws.Cells(i, 1) = Cells(1, 1) Then buf = buf & ws.Cells(i, 4) & "," End If End If Next i Cells(k, j) = Cells(k, j) & M & "回(" & N & "," & Left(buf, Len(buf) - 1) & ")" buf = "" Next j Next k For k = 3 To Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To Cells(k, Columns.Count).End(xlToLeft).Column Cells(k, 2) = Cells(k, 2) & WorksheetFunction.Substitute(Cells(k, j), "1回", "") & "," Next j Next k For k = 3 To Cells(Rows.Count, 2).End(xlUp).Row N = Len(Cells(k, 2)) - Len(WorksheetFunction.Substitute(Cells(k, 2), ",", "")) Cells(k, 2) = WorksheetFunction.Substitute(Cells(k, 2), ",", "", N) Next k Columns(2).AutoFit j = UsedRange.Columns.Count Range(Columns(3), Columns(j)).Delete Application.ScreenUpdating = True End Sub 'この行まで ※ For~Nextを多少していますので、スマートでないかもしれません。 他に良い方法があればごめんなさいね。m(_ _)m
その他の回答 (1)
- mitarashi
- ベストアンサー率59% (574/965)
#1さんの多重ループに敬服します。頭の体操にオブジェクト指向?でやってみましたが、「分からん」のは同様と思います。 もっと簡単な方法が無いとは言えませんが、いずれにせよメンテナンス困難なものになりそうなので、Accessのクエリでできる範囲のまとめ方で我慢されるのが、生産的と思います。 Sub test() Dim personalData As Collection Dim personalInfo As personalClass Dim targetRange As range, myRow As range, destRange As range Dim myName As String Dim rankInfos(50) As Object Dim i As Long, myRank As Long Dim myKey As Variant, myKeys As Variant Dim buf As String Const lowestRank = 10 '任意に変更して下さい Set personalData = New Collection With ThisWorkbook.Worksheets(1) Set targetRange = .range(.range("A2"), .range("A" & .Rows.count).End(xlUp)).Resize(, 4) End With Set destRange = ThisWorkbook.Worksheets(2).range("A3") For Each myRow In targetRange.Rows '累積の履歴を個人別にまとめる myName = myRow.Cells(2).Value On Error GoTo errHandle Set personalInfo = personalData(myName) personalInfo.add myRow.Cells(3).Value, myRow.Cells(4).Value On Error GoTo 0 '今月の履歴を順位別にまとめる If myRow.Cells(1).Value = ThisWorkbook.Worksheets(2).range("A1").Value Then myRank = CLng(Replace(myRow.Cells(3).Value, "位", "")) If rankInfos(myRank) Is Nothing Then Set rankInfos(myRank) = CreateObject("Scripting.Dictionary") End If If Not rankInfos(myRank).exists(myRow.Cells(2).Value) Then rankInfos(myRank).add myRow.Cells(2).Value, 1 Else rankInfos(myRank)(myRow.Cells(2).Value) = rankInfos(myRank)(myRow.Cells(2).Value) + 1 End If End If Next myRow For i = 1 To lowestRank destRange.Value = CStr(i) & "位" buf = "" If Not rankInfos(i) Is Nothing Then myKeys = rankInfos(i).keys For Each myKey In myKeys If rankInfos(i)(myKey) > 1 Then buf = buf & myKey & rankInfos(i)(myKey) & "回" Else buf = buf & myKey End If buf = buf & personalData(myKey).history(CStr(i) & "位") & "," Next myKey destRange.Offset(0, 1).Value = Left(buf, Len(buf) - 1) End If Set destRange = destRange.Offset(1, 0) Next i Exit Sub errHandle: Set personalInfo = New personalClass personalData.add personalInfo, myName Resume Next End Sub 'クラスモジュール personalClass Dim myName As String Dim rankCollection As Collection Private Sub Class_Initialize() Set rankCollection = New Collection End Sub Public Sub add(newStrRank As String, location As String) Dim buf As Variant Dim historyCls As historyClass On Error GoTo newMenber Set buf = rankCollection(newStrRank) Set historyCls = rankCollection(newStrRank) With historyCls .add location End With Exit Sub newMenber: Set historyCls = New historyClass rankCollection.add historyCls, newStrRank Set historyCls = Nothing Resume Next End Sub Public Property Get history(strrank As String) As String Dim historyCls As historyClass On Error GoTo errHandle Set historyCls = rankCollection(strrank) history = "(" & CStr(historyCls.count) & ", " & historyCls.location & ")" Exit Property errHandle: history = "" End Property 'クラスモジュール historyClass Private myCount As Long Private myLocation As String Private myRank As String Public Sub add(location As String) If myLocation = "" Then myLocation = location myCount = 1 Else myLocation = myLocation & ", " & location myCount = myCount + 1 End If End Sub Public Property Get location() As String location = myLocation End Property Public Property Get count() As Long count = myCount End Property Public Property Let rank(newRank As String) myRank = newRank End Property
お礼
mitarashiさま 早速のご回答、ありがとうございます。 いただいたコードを実行しようとしたところ、 Public Sub add(location As String)のところでコンパイルエラー:名前が適切ではありません:addという エラーメッセージに出会い、行き詰ってしまいました。 いただいた画像ではきっちりマクロが実行され、データが出力されているようでしたので おそらく私の方で何かおかしな操作をしたか、設定がおかしいかではないかと思っております。 そういった意味でも、私が理解できていないものをいきなりそのまま利用することは おっしゃるとおりメンテナンスが困難になるため危険ですので どこがネックで戴いたコードを実行できないでいるのか、 自分で理解しそれを修正できるようになってから利用させていただきたいと思います。 私にとってはまずはVBAでこういった帳票が作成可能であるということを知っただけでも大収穫です。 今後は少しずつ、VBAを学んでいき、理解していければと思っております。 最後になりましたが、貴重なお時間を割いていただき 丁寧なご回答ほんとうにありがとうございました。
関連するQ&A
- Excel 条件に該当する行の異なるセル参照
エクセル初心者ですが、質問をさせて頂きます。 関数を利用してSheet2に下記のような記録データを貼り付け A B C D 1 名前 組 成績 組内順位 2 山田 1 280 1 3 伊藤 1 233 2 4 佐藤 3 298 1 5 山本 2 264 1 6 斉藤 3 215 2 7 田中 2 256 2 Sheet1のC列に該当者名を参照する方法はございませんでしょうか? A B C 1 組 順位 名前 2 1 1 3 1 2 4 2 1 5 2 2 6 3 1 7 3 2 [=INDEX(Sheet2!A:A,MATCH(AND(Sheet2!B:B=A2,D:D=B2),Sheet2!A:D,0))] このような形でC2から検査値をずらして 試してみているのですがなかなかうまくいきません。
- ベストアンサー
- その他(業務ソフトウェア)
- Excleで文字列の検索合成がしたいのですが
エクセルの神様教えてください。ワークシートでA列はグループ。B列は順番とでもご理解下さい。 下のような並びのC列の文字をB列の順番で合成したいのですが・・・但しB列の数は大小あるんですけど、ワークシートの並びは見にくくなるのでソートは出来ません。 *A B C 1 10 1 甲 2 10 3 乙 3 12 1 丙 4 10 2 丁 5 11 2 戊 6 11 1 己 VVV結果VVV *A B 1 10 甲丁乙 2 11 己戊 3 12 丙 B列にどんな計算式を入れたら良いでしょうか?
- 締切済み
- オフィス系ソフト
- エクセルにて「期間指定」で「データ集計」する方法
エクセルで営業商談用顧客管理を行っています。 シート1には、商談日を下記のように記載しており A列 B列 日付 担当 1/1 山田 1/6 田中 1/8 佐藤 2/3 山田 2/4 山田 2/6 佐藤 2/9 田中 3/1 佐藤 3/2 山田 3/5 佐藤 別シートにて、例えば1月にどの担当が何件商談をしたか、を 下記のように管理したいのですが 山田 ○件 田中 ○件 佐藤 ○件 こちらの関数の指定方法について、ご教授いただけないでしょうか? よろしくお願いします
- 締切済み
- マーケティング・企画
- エクセルで同じ名前の該当データを抽出する方法
よろしくお願いします。 昨日質問させていただき、ご回答を頂き、既に締め切っている内容について、困っております。 締め切った質問は、QNo.3223413「エクセルの関数?について」 質問内容は、 「お世話になります。 今、次のような調書を作成中ですが、処理効率を上げるためにエクセルの関数?を活用してと考えております。 シート1には、次のようなデータが入っております。 「・・」本質問のために各セルの位置を合わせるために 入れているだけです。 ・・・・A・・・B・・・C・・・D・・・E・・・ 1・・氏名・・1位・・2位・・3位・・4位・・・ 2・・佐藤・・・・・・・○・・・・・・・・・・・ 3・・吉田・・・○・・・・・・・・・・・・・・・ 4・・伊藤・・・・・・・・・・・・・・・○・・・ シート2に、シート1のデータを参照して、氏名の該当者に 対して、B2以降に該当順位を付す方法を教えてください。 ・・・・A・・・B・・・ 1・・氏名・・順位・・・ 2・・佐藤・・2位 3・・吉田・・1位 4・・伊藤・・4位 シート1は外部から受けたデータであり、シート2は内部で 新たに加工する調書です。1500件ぐらいあるので、何と かエクセルを活用したいと考えておりますので、よろしく お願いします。」 であり、回答いただき当初の目的に対応する回答の「LOOKUP」を採用して作業を進めておりましたが、シート1を上から順番にLOOKUPしていく場合は、回答いただいたままでOKでしたが、シート2を作成において、佐藤○○と打込めば、シート1の同姓同名である佐藤○○を見に行って反映する方法を教えてください。 確かに、ご回答いただいた方々の中には、シート1とシート2が同じ順番で作成されている場合を想定してご教授いただいており、私の質問の不足でご迷惑をお掛けいたしますが、よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルで、品物毎に詳細を纏めたい
いつもお世話になっています。 早速ですが、下記のようなことをしたいのですが、エクセルでできるでしょうか? sheet1 │ A │ B ----------------------- 1│品 名│ 詳細 ----------------------- 2│ 甲 │ a ----------------------- 3│ 乙 │ b ----------------------- 4│ 丙 │ c ----------------------- 5│ 乙 │ い ----------------------- 6│ 丙 │ う ----------------------- 7│ 甲 │ あ ----------------------- ↓ sheet2 │ A │ B ----------------------- 1│品名 │ 詳細 ----------------------- 2│ 甲 │ a ----------------------- 3│ 甲 │ あ ----------------------- 4│ 乙 │ b ----------------------- 5│ 乙 │ い ----------------------- 6│ 丙 │ c ----------------------- 7│ 丙 │ う ----------------------- A列に品名、B列にその詳細を入力します。 「品名甲~丙、それ以降」は、その時々で詳細が微妙に変わりますが、順番に入力していきますので、例えば詳細の変化した「甲」が下の方で追加されます。 それがsheet1です。 sheet1を基に「甲の詳細がどう変わったか?」を纏める表(sheet2)を作りたいのですが、 これが自動的に出来上がるような方法はあるでしょうか? sheet2の「Bの2」にsheet1を範囲にしたVLOOKUPを入れ、「Aの2」に「甲」と入れると「Bの2」には「a」と表示されます。 が、「Bの2」をドラッグして「Aの3」に「甲」と入れても「Bの3」には「a」と表示され「あ」は表示されません。 「Bの3」には「あ」と表示したい、つまりsheet2は品名ごとに詳細を上下に纏めた一覧表にしたいのですが、その方法について何か良い知恵はございませんでしょうか? 関数には拘っておらずマクロでも何でも構いませんので、お知恵をお持ちの方がいらっしゃいましたらご教示下さい。
- ベストアンサー
- オフィス系ソフト
- エクセルの検索関数について
エクセルの検索関数について、以下のことで教えてください。 以下のような甲~丁製品データが並んでいます。B列にはチェックボックスを配置し、例えば「丙社製品」を選ぶ場合にB3にあるチェックボックスにチェックしてA3セルが「TRUE」となるようにセットされています(チェックしたチェックボックスは■で表現しています)。チェックされる(TRUEとなる)製品は一つだけです。 <シート名:製品リスト> A B C 1 FALSE □ 甲社製品 2 FALSE □ 乙社製品 3 TRUE ■ 丙社製品 4 FALSE □ 丁社製品 そこで、『本シート内A1~A4中の「TRUE」に該当する製品名(C列の何れか)を拾って』別シートのあるセルに「○社製品」と掲載したいのです。 IF関数でも可能なのですが、製品が7つ以上の場合には使えません。VLOOKUP関数をやってみましたが、A列の「TRUE」「FALSE」がランダムになる為、「昇順」とならず、エラーが出てしまいます。 単純なことなのかもしれませんが、壁に当たっています。 どなたか分かる方がいましたら教えてください。
- ベストアンサー
- オフィス系ソフト
- 該当するデータを集計したい
集計についての質問です。 よろしくお願い致します。 A1:N?(最終行は定まっておりません。ファイルによってまちまちです)の表があります。 A列に入力されている文字が11文字(半角のアルファベット1文字+数字10桁)、且つB列が空白のとき、 その同じ行のC列:N列の情報を1つのシートに集計をしたい。 【環境】 同じフォルダ内にエクセルファイルがいくつかあります 保存されているエクセルファイルは全て集計の対象になります 表の形式は全て同じになります シートは全て1枚で同じシート名になります 集計シートの2行目より該当するデータをあるだけ追加していくようなイメージになります。 要は同じフォルダ内の複数のエクセルファイルで、該当するデータを、 新たに1つのシートでまとめたいと考えております。 該当データが不特定なので追記していく方法がよくわかりません。 どなたかご教授いただけますでしょうか
- 締切済み
- オフィス系ソフト
- エクセルの数式
エクセルの数式の質問です 例えば 佐藤さんがいて、その佐藤さんは甲項目はA、乙項目はB、丙項目はC、丁項目はAという評価だったとします。 会社の基準では、Aは10点、Bは5点、Cは1点と決められています。 この場合、佐藤さんの合計得点は26点になりますが、これを数式で一発で表したい場合、どのように数式を組み立てたらいいのでしょうか。 評価の欄にAやBを打ち込むだけで自動的に26点と出てくるようにしたいのですが・・・
- ベストアンサー
- Windows XP
- Excel VBAで比較させたい。
sheet1のA1に山田さん、B1に佐藤さんと打ちます。 で、sheet2のA列に山田さんB列に佐藤さんの情報があります。 それを比較する方法を知りたいんですけど。 ちなみに、sheet1のA1に鈴木さん、B1に山崎さんなど色んなパターンが存在します。 A1に山田さんだったらsheet2のA列、B1に佐藤さんだったらsheet2のB列を見に行って それを比較して、一致しない所だけsheet3に表示させる方法などありますか? 当方まったくの初心者で…(^^;
- ベストアンサー
- Visual Basic
- (エクセル)日付に相当するデータを入力する
シート1に以下のように、A列には氏名、C列に日付がランダムに入力されています。 A B C 1 山田 4/4 3:00 2 佐藤 4/3 2:00 3 石井 4/4 3:00 4 加藤 4/3 2:00 5 田中 4/1 5:00 シート2に上から順位に並び替えたいです A B C D E F G 1 4/1 4/2 4/3 4/4 4/5 2 1 田中 4/1 5:00 3 2 佐藤 4/3 2:00 4 3 加藤 4/3 2:00 5 4 山田 4/4 3:00 6 5 石井 4/4 3:00 1行目のC~Gには既に4/1~4/5が入力されています。 対応するところに日付を入力し、さらにB列には氏名を表示したいです。 C2には「=IF(AND(SMALL(Sheet1!$C$1:$C$5,$A2)<D$1,SMALL(Sheet1!$C$1:$C$5,$A2)>=C$1),SMALL(Sheet1!$C$1:$C$5,$A2),"")」としてうまくいきました(C1:F6も同様)。 問題はB列なのですが、B2に「=INDEX(Sheet1!$A$1:$A$5,MATCH(SUM(C2:G2),Sheet1!$C$1:$C$5,0))」や「=INDEX(Sheet1!$A$1:$A$5,MATCH(SMALL(Sheet1!$C$1:$C$5,A2),Sheet1!$C$1:$C$5,0))」としても同じ失敗結果になりました。 両方とも、上から順に 田中 佐藤 佐藤 ←失敗(加藤が正解) 山田 山田 ←失敗(石井が正解) となってしまい、重複する日付が失敗してしまいます。 B列にどのようにしたら良いか教えてください。 よろしくお願いします。
- 締切済み
- Excel(エクセル)
お礼
tom04さま 早速のご回答、ありがとうございます。 いただいた手順どおりに実行したところ、思い通りのデータが出力されたためたいへん感服しております。 まずはこういったことがVBAで可能であることがわかり、ほんとうにありがたく思っております。 今後はVBAを学んでいき、自分で一つ一つの要素が何を意味しどう構成されているのかを理解していき 突発的なエラーや要素の追加にも耐えうるように、またメンテナンスやちょっとした応用が自分でできるようになっていきたいと思います。 重ねがさね、ほんとうにありがとうございました。