[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Aシートの蓄積データをBシートの表に飛ばす』（くりた）
お助け下さい。
Aシートに蓄積データを入力しています。
そのデータをBシートに飛ばしたいです。
Aシートは蓄積データとして日付、入力者氏名、
業務内容、人数を行に入力して蓄積していきます。
そのデータをBシートの列に日付、
行に業務内容と人数を365日分ある表に
飛ばしたいです。
なお、特定の日付に業務内容が複数回重なった場合、
2、3、4、、、とプラスし
同じく人数もプラスし表を完成させたいです。
ご教授お願いいたします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
>>なお、特定の日付に業務内容が複数回重なった場合、2、3、4、、、とプラスし
この意味がわかりにくいのですが・・ たとえばサンプルとして、使用前、使用後のレイアウトを
[[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）
ここに掲載されている、ｍｏｍｏさんのユ―ティリティを使ってアップしてみてはいかがですか？
●いずれにしても、あらかじめ用意してあるマトリックスに埋めるのではなく、存在するデータから 縦横のマトリックスに展開するので、要件にはあわないかもしれませんが、ピボットを使えば なんとなく、それなりのものができそうですけど。
（β） 2016/03/10(木) 21:05
もしAシートとBシートのレイアウトが以下であれば Bシートの B2 に =SUMIFS(A!$D:$D,A!$A:$A,B$1,A!$C:$C,$A2) これを、下に、右にフィルコピー とか。
|[A] |[B] |[C] |[D]
[1] |日付 |氏名|業務|人数
[2] |2月1日| |あ | 1
[3] |2月2日| |い | 2
[4] |2月3日| |う | 3
[5] |2月1日| |え | 4
[6] |2月2日| |お | 5
[7] |2月3日| |あ | 6
[8] |2月4日| |い | 7
[9] |2月5日| |う | 8
[10]|2月6日| |え | 9
[11]|2月7日| |お | 10
[12]|2月1日| |あ | 11
[13]|2月2日| |い | 12
[14]|2月3日| |う | 13
|[A] |[B] |[C] |[D] |[E] |[F]
[1]|業務|1月1日|1月2日|1月3日|1月4日|1月5日
[2]|あ | | | | |
[3]|い | | | | |
[4]|う | | | | |
[5]|え | | | | |
[6]|お | | | | |
（β） 2016/03/10(木) 21:19
念のため 下の表が1月1日〜になってます。
Sheet2の B2=SUMIFS(Sheet1!$D:$D,Sheet1!$A:$A,B$1,Sheet1!$C:$C,$A2) これを、下に、右にフィルコピー ************************************
Sheet1
************************************
|[A] |[B] |[C] |[D]
[1] |日付 |氏名|業務|人数
[2] |2月1日| |あ | 1
[3] |2月2日| |い | 2
[4] |2月3日| |う | 3
[5] |2月1日| |え | 4
[6] |2月2日| |お | 5
[7] |2月3日| |あ | 6
[8] |2月4日| |い | 7
[9] |2月5日| |う | 8
[10]|2月6日| |え | 9
[11]|2月7日| |お | 10
[12]|2月1日| |あ | 11
[13]|2月2日| |い | 12
[14]|2月3日| |う | 13
Sheet2
************************************
|[A] |[B] |[C] |[D] |[E] |[F]
[1]|業務|2月1日|2月2日|2月3日|2月4日|2月5日
[2]|あ | 12| 0| 6| 0| 0
[3]|い | 0| 14| 0| 7| 0
[4]|う | 0| 0| 16| 0| 8
[5]|え | 4| 0| 0| 0| 0
[6]|お | 0| 5| 0| 0| 0
（マリオ） 2016/03/10(木) 21:48
■入力フォーム
日付 ★1月1日
入力者氏名 くりた
出向名 ★買い出し
車両数 3 人数 ★9
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Ａシート
■蓄積テーブル
日付 入力者氏名 出向名 車両数 人数 1 ★1月1日 くりた ★買い出し 3 ★9 2 1月4日 くりた 広報活動 2 6 3 1月5日 くりた 講話活動 2 6 ・ ・ ・ ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Ｂシート
｜買い出し｜人数｜広報活動｜人数｜・・・・・・
1月1日｜ ★1 ｜ ★9 ｜ ｜ ｜
1月2日｜ ｜ ｜ ｜ ｜
1月3日｜ ｜ ｜ ｜ ｜
・
・
・
・
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
というふうに作りたいです。
入力フォームからＡシートへの転記はできているんですが。。。。
★を
（くりた） 2016/03/10(木) 22:11
To マリオさん
>>下の表が1月1日〜になってます。
日付は１年分、ずら〜っと記載されているようですので。 アップしたのは、一部分です。
★いずれにしても、レイアウトが完全に違っていたようですので アップした式は使えませんけどね。
（β） 2016/03/10(木) 22:34
|[A]|[B] |[C] |[D] |[E] |[F]
[1]| |日付 |入力者氏名|出向名 |車両数|人数
[2]| 1|★1月1日|くりた |★買い出し| 3|★9
[3]| 2|1月4日 |くりた |広報活動 | 2| 6
[4]| 3|1月5日 |くりた |講話活動 | 2| 6
■入力フォーム から、Ａシート へのデータ書き込みは、マクロでやられているんですよね？ 現在は、上表のようになっていますよね。これを下表のように、してみては？ 文字列の先頭に★印があれば、B,E,H列に★を付けるようにマクロをいじるだけ。 マクロは編集したことありますか？
[[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）
は使用したことありますか？
|[A]|[B]|[C] |[D] |[E]|[F] |[G] |[H]|[I]
[1]| | |日付 |入力者氏名| |出向名 |車両数| |人数
[2]| 1|★ |1月1日|くりた |★ |買い出し| 3|★ | 9
[3]| 2| |1月4日|くりた | |広報活動| 2| | 6
[4]| 3| |1月5日|くりた | |講話活動| 2| | 6
（マリオ） 2016/03/11(金) 00:25
A案とB案、どちらがいいですか？
入力フォーム から、Ａシート へのデータ書き込みをするマクロのコードを載せられますか？ ■A案■マクロをいじって、 現在のAシート→（作業シート）→Ｂシート
または、マクロはいじらず、作業シートを別に作るとか。 ■B案■現在のAシート→（作業シート）→Ｂシート （マリオ） 2016/03/11(金) 00:37
間違えた ■A案■マクロをいじって、 現在のAシート → Ｂシート ■B案■マクロはいじらず、現在のAシート → （作業シート） → Ｂシート （マリオ） 2016/03/11(金) 00:39
マクロはマリオさんにおまかせして、レイアウトが以下のようなもので、Bシートには、あらかじめ A列の日付と1行目の項目が記載されているなら。
Bシートの、
B2 : =COUNTIFS(A!$A:$A,$A2,A!$C:$C,B$1) C2 : =SUMIFS(A!$E:$E,A!$A:$A,$A2,A!$C:$C,B$1)
B2:C2 を選択して 右にフィルコピー。そのまま下にフィルコピー。 これでいかがですか。
|[A] |[B] |[C] |[D] |[E]
[1] |日付 |入力者氏名|出向名 |車両数|人数
[2] |1月1日|くりた |買い出し| 3| 9
[3] |1月2日|くりた |広報活動| 2| 6
[4] |1月3日|くりた |講話活動| 1| 3
[5] |1月1日|田中 |買い出し| 3| 8
[6] |1月2日|田中 |広報活動| 2| 5
[7] |1月3日|田中 |講話活動| 1| 2
[8] |1月1日|山田 |広報活動| 3| 8
[9] |1月2日|山田 |講話活動| 2| 5
[10]|1月3日|山田 |買い出し| 1| 2
|[A] |[B] |[C] |[D] |[E] |[F] |[G]
[1]| |買い出し|人数|広報活動|人数|講話活動|人数
[2]|1月1日| | | | | |
[3]|1月2日| | | | | |
[4]|1月3日| | | | | |
（β） 2016/03/11(金) 08:38
A案はマリオさんから回答があると思いますので、↑でコメントした数式処理をマクロ化したもの、参考までに。 (B案に近いですが、作業シートを使わず、直接、Bシートに展開します）
Sub Sample()
Dim r1 As Range
Dim r2 As Range
With Sheets("B")
With .Range("A1").CurrentRegion
Set r2 = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
Set r1 = r2.Rows(1)
End With
.Range("B2").Formula = "=COUNTIFS(A!$A:$A,$A2,A!$C:$C,B$1)"
.Range("C2").Formula = "=SUMIFS(A!$E:$E,A!$A:$A,$A2,A!$C:$C,B$1)"
.Range("B2:C2").AutoFill Destination:=r1, Type:=xlFillDefault
r1.AutoFill Destination:=r2, Type:=xlFillDefault
r2.Value = r2.Value
End With
End Sub
（β） 2016/03/11(金) 09:05
To くりた さん
＞入力フォームからＡシートへの転記はマクロで行っています。 Ａ案で完成するために、そのマクロコードを載せてください。
開発タブ→Visual Basic→表示にてプロジェクトエクスプローラー →VBAProject（●●●.xls）またはVBAProject（●●●.xlsm） の下階層を展開して、フォームタブ内の、UserForm1の上で、右クリック →右クリックすると、一覧に「コードの表示」が表示されるので、これを左クリック 右側にコードが表示されると思うので、これを一度、メモ帳などにコピペしてください。
掲載しては、まずい部分は、部分的に伏せ字にするなど編集。 編集が終わったコードを掲示板にコピペしてください。
■開発タブの表示の仕方 http://plaza.rakuten.co.jp/mscrtf/diary/201302250000/ （マリオ） 2016/03/11(金) 12:29
To くりた さん
UserForm1のコードの他に、
Sheet1, Sheet2, ThisWorkbook, Module1 などを左ダブルクリックすると、コード欄が表示されます。 コードが表示されてましたら、そのコードも掲載してください。 （マリオ） 2016/03/11(金) 12:36
おはようございます。
返信が遅れまして申し訳ございません。
毎度お手数ですがよろしくお願いします。
Sub 転記()
Dim formSheet As Worksheet, dataTable As Range
Dim newRecordRange As Range, i As Long
Dim addressList()
Set formSheet = Sheets("入力フォーム")
Set dataTable = ThisWorkbook.Names("出場状況テーブル").RefersToRange
addressList = Array("C4", "C6", "C7", "C8", "F8")
Set newRecordRange = dataTable.Rows(1).Offset(dataTable.Rows.Count)
For i = 0 To UBound(addressList)
newRecordRange.Cells(1, i + 1).Value = formSheet.Range(addressList(i)).Value
Next
End Sub
Sub テーブル範囲更新(tableName As String)
'Sub テーブル範囲更新()
Const tableName = "出場状況テーブル"
Dim targetName As Name
Dim curTable As Range, lastRecord As Range
Set targetName = Names(tableName)
Set curTable = targetName.RefersToRange
Set lastRecord = curTable.Rows(1).Offset(curTable.Rows.Count - 1)
lastRecord.Copy
lastRecord.Offset(1, 0).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
'「出場状況テーブル」の参照するセル範囲を更新(CurrentRegion方式)
targetName.RefersTo = curTable.CurrentRegion
End Sub
Sub 新規登録()
Call 新規レコード転記
' Call テーブル範囲更新
Call テーブル範囲更新("出場状況テーブル")
MsgBox "転記を完了しました"
End Sub
Function 連番取得(myTable As Range) As Integer
Dim tmpNo As Integer
tmpNo = Application.WorksheetFunction.Max(myTable.Columns(1))
連番取得 = tmpNo + 1
End Function
Option Explicit
（くりた） 2016/03/12(土) 09:19
ご丁寧に回答いただきありがとうございます。
とても勉強になります。
仕事がはかどりますので
すごく助かります。
（くりた） 2016/03/12(土) 09:30
To くりた さん コードが一部分しか載ってませんね。 Call 新規レコード転記とあるけど、その「新規レコード転記」のコードないですね。
エクセルファイルを次のどちらかのURL先でアップしてみては？個人情報を削除してから。
http://ww10.puny.jp/uploader/ http://www.dotup.org/76.html?1448908210
エクセルファイルをアップする前に、 ファイル上で右クリック、プロパティ→詳細→ プロパティや個人情報を削除→このファイルから次のプロパティを削除 のラジオボタンを選択→すべて選択ボタンを押す→OK で個人情報を削除 （マリオ） 2016/03/12(土) 13:30
すみませんでした。
お手数おかけします。
感謝です。
http://ww10.puny.jp/uploader/download/1457760858.xlsm
PASS 110119
よろしくお願いします。
（くりた） 2016/03/12(土) 14:37
To くりた さん ダウンロードしたので、削除しても構いませんよ。 （マリオ） 2016/03/12(土) 15:02
（くりた） 2016/03/12(土) 16:47
下記URL先のファイル、どうでしょうか？ すいません、考え中です。
（転記001.xlsm）ダウンロードパスワード：abc http://ww10.puny.jp/uploader/download/1457774217.zip ******************************************************* データシートから、グラフシートにデータを送りたいんですよね。
データシートがG列で終わってますが、 ★グラフシートの３行目、4行目にある項目をデータシートのH列より右側に、項目を作って、 ★出向名別に人数をカウントすれば、簡単ですよね。
別にシート（シート名：集計）を作って、データシートの日付別に人数を合計する。 もちろん、データシートのH列より右側も合計する。 この集計シートのデータをグラフシートに送る。
★入力フォームとデータシートで、 ★出向名をプルダウンリストから選べるようするのが簡単かと。 どんなリストにするかは、 グラフシートの３行目、4行目の内容になるかと。
グラフシートのCA列〜CR列は、とりあえず考えなくていいのかな？ *********************************************** 検索シートでは、何をしたいのでしょうか？ 検索条件の日付欄、氏名欄に入力して、 下の検索テーブルで、データシートから 絞り込んで情報を表示するとか？ **********************************************
（マリオ） 2016/03/12(土) 18:53
ありがとうございます。
少しさわってみます。
検索シートでは
検索条件から
下の検索結果テーブルに情報取り出せればと思いまして。。。
（くりた） 2016/03/12(土) 20:07
To くりた さん
とりあえず、入力フォームシートのC7,C8に ドロップダウンリストを設定してみました。 今日は、ここまで。
出向名シートは、通常、シート名上で右クリックして、 一覧の非表示を選択して、非表示にしておいてください。
（転記002.xlsm）ダウンロードパスワード：abc http://ww10.puny.jp/uploader/download/1457785814.zip
*****************************************************************
入力シートに次を記述してます。
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C7")) Is Nothing Then Exit Sub
Range("C8:G8").ClearContents
End Sub
*****************************************************************
（マリオ） 2016/03/12(土) 21:37
本当にありがとうございます（泣）
（くりた） 2016/03/12(土) 22:01
途中ですが、感想を聞かせてください。
あとは、集計シート（シート名：集計）にて、【小計機能】にて日付ごとに、合計値を求める。
そして、日付ごとの合計値をグラフシートに貼り付ければ、終了です。
（転記003.xlsm）ダウンロードパスワード：abc http://ww10.puny.jp/uploader/download/1457873495.zip （マリオ） 2016/03/13(日) 22:01
To くりた さん 完成しました。 関心があればアップします。（転記004.xlsm〜転記006.xlsm） （マリオ） 2016/03/14(月) 19:19
転記003
拝見しました。
すごすぎます。
よければいただきたいです。
（くりた） 2016/03/14(月) 21:52
To くりた さん
PCの復旧後、PCに問題ありませんか？ 私なんかは、大事なファイルはTranscend製のUSBメモリ（32GB）と外付けHDD2台に置いています。 いつでも、OSのクリーン再インストールできるように。システムの復元だと治らないときありますよね。 最近、128GBの高速転送できるUSBメモリがほしいです。
ファイルを下記URL先に、置いておきます。 コメントをくださっているβさんにも見て頂きたいのですが、 下記URL先のファイルをβさんに見て頂いてもよろしいでしょうか？
http://ww10.puny.jp/uploader/download/1458050311.zip
転記004.xlsx〜転記006.xlsx（ダウンロードパスワード：abc） おまけで、@（シートレイアウト）.xlsを付けてます。
転記006.xlsxの入力シートに、使用上の注意などを書いておきました。 （転記004.xlsxと転記005.xlsxは作成途中のファイルです。削除して構いません。） 転記006.xlsxですが、なんか、いろいろ詰め込みました(^^♪ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
作業シートである（検索シート、集計シート）を削除したり、隠したりしないようにする為の設定です。 次の設定をすると、どんなことが行われているのかを確認できます。 ***************************************************************************************** Sub 検索()にて、次の★が付いている行の先頭に「'」をつけてコメント化してください。
'不要になった検索シートを削除する
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "検索" Then
Application.DisplayAlerts = False
sh.Delete'★★★★★★★★★★★★★★★★★★★★★
Application.DisplayAlerts = True
End If
Next
*****************************************************************************************
Sub 集計()にて、次の★が付いている行の先頭に「'」をつけてコメント化してください。
sh5.Cells.RemoveSubtotal '小計機能削除'★★★★★★★★★
sh5.UsedRange.Clear 'データ削除'★★★★★★★★★★★★
sh5.Visible = False '隠す'★★★★★★★★★★★★★★★
（マリオ） 2016/03/15(火) 23:16
To マリオ さん
圧巻です。
PCはいまだに復旧中です。。。
βさんにぜひ見てもらってください。
本当に助かりました。
弟子入りさせてくださいｗｗｗ
（くりた） 2016/03/16(水) 00:08
To βさん
ファイル見てもらえませんか？お願い致します。
（マリオ） 2016/03/16(水) 00:29
To マリオさん
お疲れ様でした。 大作、とりあえずダウンロードしました。ゆっくりと見せていただきます。
To くりたさん
マリオさんはとても親切な先生ですから、いつも、いたれりつくせり、かゆいところに手が届くフルセットのコードを 提供してくださいますが、急ぎの場合は、それを、そのまま使って解決 ということでしょう。 でも、肝心なのは、くりたさん自身が、自分でコードを書くことができるようになるということですね。 肝心 というより そのほうが楽しいですよね。
なので、マリオさんからいただいたコードとは別に、自分で書ける範囲で、自分流のコードも書いてみて試してみる。 そんなことも重要だと思います。
（β） 2016/03/16(水) 06:20
To βさん β先生、ゆっくりご覧になってください(^^)/ 何か気になる点がありましたらアドバイス願いますm(_ _)m
To くりたさん コードで、変な所がありました！訂正してください。
Sub 空欄チェック()のところですが、次のように訂正してください。 ■（訂正後）
If flag = True Then MsgBox sh2.Name & "シートに、空欄はありません。"
*********************************************************************** Private Sub Empty_Checkのところですが、次のように訂正してください。 ■（訂正後）
MsgBox sh.Name & "シートに、空欄のセルがあります。" & vbCrLf & _
Mid(msg, 1, Len(msg) - 1), vbCritical
*********************************************************************** また、Module2にある「Sub 検索()〜End Sub」を全て切り取って、Module1に貼り付けてください。 貼付け場所は、「Sub 登録()」と「Sub 集計()」の間がよろしいかと。
■Sub 検索()をmodule1に貼り付け後、次のように訂正（下記の★印箇所を追加）
If Sheets("条件").Range("C4:H4").SpecialCells(xlCellTypeBlanks).Count = 6 Then
MsgBox "検索する前に、条件を入力してね！"
Exit Sub
End If
Call 空欄チェック'★★★この場所に、コードを追加する！
Application.ScreenUpdating = False
（マリオ） 2016/03/16(水) 10:05
ありがとうございます。
修正しました。
1つ質問してよろしいでしょうか？
出向名に増減があり、修正をしているところなんですが、
リストの増減とグラフの増減は終わりましたが、
肝心な集計シートの関数？が見ることができません。泣
どのようにして非表示にされているのですか？
いつもいつもすみません。
TO βさん
仰るとおりです。
今回は年度末ということもあり、
時間に余裕がなくお世話になりっぱなしでしたが、（マリオさんに頭が上がらない。）
少しずつ経験を重ねて
少しでも多くエクセルを使いこなせるように頑張ります。
（くりた） 2016/03/16(水) 14:09
To くりたさん
出向名シートの「出向名1と出向名2」を編集したんですかね。 その後で、グラフシートのシート保護を解除して、 グラフシートの3行目、4行目(D列〜BY列＋α列）を編集されたんですかね。
その状況を確認したいので、ファイルを何処かに置いてもらえませんか？ 状況が分かってないと、遠回りになるかもしれないので、 くりたさんがコードを理解できるように解説していきますので。
Sub 集計()のコードをを少し編集しないといけませんね。
>肝心な集計シートの関数？が見ることができません。泣
どのようにして非表示にされているのですか？
集計シートでは、関数は使用していません。 グラフシートの集計ボタンを押した後、非表示になっている集計シートを見ても、 何も書き込まれていないです。下記の（１か所）〜（４か所）を修正すれば、 集計シート覗くことができます。
2016/03/15(火) 23:16の記事で、書きましたが、
Sub 集計()にて、次の★が付いている行の先頭に「'」をつけてコメント化してください。 Module1にて、「Ctrl+F」で検索して見つけてください。
sh5.Cells.RemoveSubtotal '小計機能削除'★★★★★★★★★（１か所）
sh5.UsedRange.Clear 'データ削除'★★★★★★★★★★★★（２か所）
sh5.Visible = False '隠す'★★★★★★★★★★★★★★★（３か所）
'■可視セルをコピー（データシート → 集計シート）
Set sh5 = Sheets("集計"): sh5.Visible = True
sh5.UsedRange.Clear’★★追加する（４か所）
（マリオ） 2016/03/16(水) 18:37
こんばんわ。
もうだめだ。
なにがなんだかわかりません。
どうやら私にエクセルのセンスはないようです。
１から勉強したい。。。
http://ww10.puny.jp/uploader/download/1458124247.xlsm
マリオさんすみません。
私がバカなばっかりに。。。
（くりた） 2016/03/16(水) 19:34
パスワードは、abcでしたね。書いてませんでしたけど(^^♪ ダウンロードしましたので、もう削除していいですよ〜 （マリオ） 2016/03/16(水) 19:38
To マリオさん
申し訳ありませんが、Ｑ／Ａ経緯をおいかけて理解する気力もなく、これら大作で、マリオさんが何をしたかったのかを すべて腹に入れるのもしんどいので、でも、せっかくダウンロードしたんだからと、ちょこっと開いてみました。
で、なにげに 転記006 の 条件シートのシートモジュールをみましたら、（特にこれをみたかったわけではなく なんとなくダブルクリックしたら、それが条件シートモジュールだったということですけど）
Changeイベントコード。これって？？？？ たとえば H4 に入力します。イベントが発生します。それが数値ではなかったとします。 エラーメッセージがでます。続いて H4 を "" にします。 そのとたんに、イベント連鎖。再入します。H4 です。で、"" なので抜けます。
H4だけではなく、対象にしているすべてのセルで同様のイベント連鎖が発生しますね。
この構成はいただけないなぁ・・・
★それと、別トピでもコメントしたことがありますすし、私以外の人もふれておられましたが Ｑ／Ａは、あくまで 質問者さんが主体です。質問者さんが、上手に着地できるようにお手伝いするのが 本意です。 で、質問者さんの多くは、マリオさんのように、様々な要件実現のためのコード知識があるわけではなく 基本的なコードを、見よう見まねで、試してみて、あぁ、こうなるんだなぁと、そういう積み重ねをしていって いつかはマリオさんのようになるでしょうけど、それまでは長い道のりです。 質問者さんには、申し訳ありませんが、小学校レベルだと思いましょう。 で、小学生に微分積分の数式を与えて、さぁどうだ！ かっこいいだろうといっても消化不良になるだけです。 あげくは
>>もうだめだ。 >>なにがなんだかわかりません。 >>どうやら私にエクセルのセンスはないようです。
こんなように、自信を喪失させることになります。
やはり気を付けたいと、そう思いますね。
To くりた さん
くりたさんは、バカでもなんでもないですよ。 一足飛びに、マリオさんのレベルに到達できるわけはありません。 本来の、くりたさんのテーマは、基本的なシンプルなコードで、まず結果をだす、というか結果をだせるものなんです。 地道に、１つ１つ、積み重ねていきましょう。
（β） 2016/03/16(水) 20:03
コメントありがとうございます。
少しずつ頑張ります。
いつかマリオさんみたいになりたいです。
（くりた） 2016/03/16(水) 21:34
To くりたさん
いや〜私の方こそ、エクセルのセンスがないようです。 まず、簡潔で分かりやすく、後から編集しやすいプログラムを作るべきなんです。本当は。 はじめに言っておきます。私のようには、なってはいけません。
くりたさんのお手伝いが半分、自分自身が実験的なプログラムを作成したいっていうのが半分 そんな感じで、コード書いてました。すいません。実験的なプログラムなんで、余計なことをしています。 βさんが指摘するChangeイベントコードなども余計なコードです。いろいろ見直しも必要です。 Sub 集計()コードのどこを編集すればいいか、見ていたのですが、作った本人が混乱してます(^^♪すいません。 もうちょい、時間かかりそうです。下記の内容になるようにコードを編集すればいいのですが。
まず、出向名シートのC列〜I列（出向名1がある領域の列） ですが、3行目より下は、出向名2以外のデータは入力しないでください。 （その列では、Sub 集計()のコードで、出向名2の最終行を判定しているんです。）
★「C19:K50」の領域を切り取って、O2（単一セル）を選択後、貼り付けてください。
■（変更前） 出向名1:9種類 出向名2:37種類 3,4行目のD列〜BY列
この場合、集計シートにて、小計機能で使う表はC列からCF列(よって、88)になります。 また、小計機能のArrayに入れる配列は、1から77（よって、77）です。 **************************************************** 6＋37×2＋2＝82 内訳は次のとおり 6 : C列からH列まで「元の表」 37×2 : I列〜CD列「37×2=74列分」 2 : CE列とCF列「日付ごとの出動回数（合計）と人員（合計）」
また1＋37×2＋2=77 内訳は次のとおり 1 : H列「元の表」 37×2 : I列〜CD列「37×2=74列分」 2 : CE列とCF列「日付ごとの出動回数（合計）と人員（合計）」 ****************************************************
■（変更後） 出向名1:7種類 出向名2:30種類 3,4行目のD列〜BK列
この場合、集計シートにて、小計機能で使う表はC列からCF列(よって、88)になります。 また、小計機能のArrayに入れる配列は、1から63（よって、63）です。 **************************************************** 6＋30×2＋2＝68 内訳は次のとおり 6 : C列からH列まで「元の表」 30×2 : I列〜CD列「30×2=60列分」 2 : CE列とCF列「日付ごとの出動回数（合計）と人員（合計）」
また1＋30×2＋2=63 内訳は次のとおり 1 : H列「元の表」 30×2 : I列〜CD列「30×2=60列分」 2 : CE列とCF列「日付ごとの出動回数（合計）と人員（合計）」 ****************************************************
To βさん
コードを見て頂きまして、ありがとうございます。 私の回答者としての対応には、問題があります。 質問者さんを主体にしていません。すいません。 また、落ち着いたら、コメントしますm(_ _)m
（マリオ） 2016/03/16(水) 21:36
To くりたさん
結局、注意しながら１２か所も編集しないといけませんでした。 こりゃ、作った本人じゃなきゃ無理す。 取り急ぎ、ファイルを置いておきます。
Sub 集計()コード内に、'★★★【編集前】を行末に付けているのが、 編集前のコードです。編集後は、その次行に記載しています。
http://ww10.puny.jp/uploader/download/1458136557.zip
転記007.xlsx（ダウンロードパスワード：abc）
■当面の課題 出向名1、出向名2が増減しても、編集しやすいように加工 Worksheet_Changeイベントの見直し
今日は、ここまでかな。
（マリオ） 2016/03/16(水) 23:03
ありがとうございます。
勉強します！！
（くりた） 2016/03/17(木) 01:54
To くりた さん
課題「出向名1、出向名2が増減しても、編集しやすいように加工」 課題を見直している最中です。
出向名シートの出向名1及び出向名2を今後編集することを想定して、コードを編集してみました。 http://ww10.puny.jp/uploader/download/1458225982.zip （転記008.xlsx ダウンロードパスワード:abc）
現在、出向名1は7つ【C列(列番号3)からI列(列番号9)までなので 7】あるので、 Sub 集計()のコードで次のようになっています。 Const s1n As Long = 7 例えば、今後、出向名1が8つになったら、「=7」を「=8」に変更してください。 なお、出向名2の個数は、コードで自動で読み取ります。
ただ、問題が出ました。処理速度が激落ち(+_+)Activateしているからです。
コードで【問題箇所】と書いた所を修正しないといけません。
R1C1形式のアドレス参照にすれば、解決するかも…。
********************************************************************
'■変更前
'sh5.Range("BR4" & ":BR" & mx).Value = _
'sh5.Range("H4" & ":H" & mx).Value
'■変更後
sh5.Activate
sh5.Range(Cells(4, z + 2), Cells(mx, z + 2)).Value = _
sh5.Range(Cells(4, 8), Cells(mx, 8)).Value
********************************************************************
なお、確認しずらいので、集計シートを処理前に表示して、処理後に非表示にすることを止めました。 処理前に、新規シートを作成して、処理後に削除することにしました。
今日は、ここまで。
（マリオ） 2016/03/17(木) 23:50
ありがとうございます。
今コードを必死になって読みこんでいます。
（くりた） 2016/03/18(金) 08:14
To くりた さん
解決策を見つけました。cellsの前でシートを指定しないとダメですね。
■下記のコードを参照して下さい。 今までは、test1を使用（列位置が固定で、A,B,C,…を使っていた。） →【結論】test4（または、test5）を使え！test3を使って、激遅だと言ってました(^^♪
**************************************************************************************************** 'シート間コピー '（ただし、単一セルではなく複数範囲セル） '（ただし、列位置は、A,B,C,…を使わず、1,2,3,…を使う）←列位置が固定ではなく、動的変数である為。 '（ただし、値のみコピーしたい）
Option Explicit
Declare Function GetTickCount Lib "KERNEL32.DLL" () As Long
'時間計測結果：0ミリ秒
Sub Test1()
Dim StartTime As Long: StartTime = GetTickCount
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Dim mx As Long
mx = 10
'***************************************
sh1.Range("C2" & ":C" & mx).Value = _
sh2.Range("B2" & ":B" & mx).Value
'***************************************
Set sh1 = Nothing
Set sh2 = Nothing
MsgBox (GetTickCount - StartTime) & "[ミリ秒]" '■計測時間（ミリ秒）
End Sub
'★エラーになる
Sub Test2()
Dim StartTime As Long: StartTime = GetTickCount
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Dim mx As Long, col1 As Long, col2 As Long
mx = 10
col1 = 2
col2 = 3
'★Cellsの前でシートを指定していないので、エラーになる。
'実行時エラー '1004':
'Range' メソッドは失敗しました: '_Worksheet' オブジェクト
'******************************************************************
sh2.Range(Cells(2, col2), Cells(mx, col2)).Value = _
sh1.Range(Cells(2, col1), Cells(mx, col1)).Value '★エラー箇所
'******************************************************************
MsgBox (GetTickCount - StartTime) & "[ミリ秒]" '■計測時間（ミリ秒）
End Sub
'時間計測結果：1875ミリ秒
Sub test3()
Dim StartTime As Long: StartTime = GetTickCount
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Dim mx As Long, col1 As Long, col2 As Long
mx = 10
col1 = 2
col2 = 3
'*************************************************************************************
sh1.Range(sh1.Cells(2, col1), sh1.Cells(mx, col1)).Copy
'sh2.Range(sh2.Cells(2, col2), sh2.Cells(mx, col2)).PasteSpecial Paste:=xlPasteValues
sh2.Cells(2, col2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'*************************************************************************************
MsgBox (GetTickCount - StartTime) & "[ミリ秒]" '■計測時間（ミリ秒）
End Sub
'時間計測結果：0ミリ秒
Sub Test4()
Dim StartTime As Long: StartTime = GetTickCount
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Dim mx As Long, col1 As Long, col2 As Long
mx = 10
col1 = 2
col2 = 3
'★ポイント！ Cellsの前にも、シートを指定する
'******************************************************************
sh2.Range(sh2.Cells(2, col2), sh2.Cells(mx, col2)).Value = _
sh1.Range(sh1.Cells(2, col1), sh1.Cells(mx, col1)).Value
'******************************************************************
MsgBox (GetTickCount - StartTime) & "[ミリ秒]" '■計測時間（ミリ秒）
End Sub
'時間計測結果：0ミリ秒
Sub Test5()
Dim StartTime As Long: StartTime = GetTickCount
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Dim mx As Long, col1 As Long, col2 As Long
Dim S_rng As Range, D_rng As Range
mx = 10
col1 = 2
col2 = 3
'***********************************************************
With sh1
Set S_rng = .Range(.Cells(2, col1), .Cells(mx, col1))
End With
With sh2
Set D_rng = .Range(.Cells(2, col2), .Cells(mx, col2))
End With
D_rng.Value = S_rng.Value
'***********************************************************
MsgBox (GetTickCount - StartTime) & "[ミリ秒]" '■計測時間（ミリ秒）
End Sub
（マリオ） 2016/03/18(金) 09:38
TO マリオさん いつもありがとうございます。
毎度すみませんが、
質問よろしいでしょうか？
Test 4については、
Sheetsの名前は下記でまちがいありませんか？
Set sh1 = Sheets("入力")
Set sh2 = Sheets("データ")
尚、Test 4全体のコードの場所については
modelu1の一番最後に入力してよろしいでしょうか？
（くりた） 2016/03/18(金) 15:26
To くりたさん
http://ww10.puny.jp/uploader/download/1458302295.zip
転記009.xlsx (zipファイル)【ダウンロードパスワード: abc 】
＞Test 4については、Sheetsの名前は下記でまちがいありませんか？ Test4は、転記***.xlsxのファイルとは、関連性がありません。 【転記009.xlsx】の【Sub 集計()】内に、 プラス文字【++++++〜++++++】で挟まれた所が２か所あるので、 そこを参照してください。
Module3にデータシートにサンプルを作成するコートを置いています。 【2016/1/1〜2016/12/31の１年分（１日３回出場）】 このサンプルで集計したところ、集計に要する時間は、こちらのPC環境では、４秒程でした。 とりあえず、使用できるレベルのものになったかと思います。
■個人情報の取り扱いについて ・シートに所属名が記載された箇所が３か所ありました。削除しました。 ・次のことをしないと、エクセルのファイル作成者が丸見えです。 エクセルファイルをアップする前に、 ファイル上で右クリック、プロパティ→詳細→ プロパティや個人情報を削除→このファイルから次のプロパティを削除 のラジオボタンを選択→すべて選択ボタンを押す→OKで個人情報を削除
（マリオ） 2016/03/18(金) 21:01
To くりたさん
まとめると、こんな感じです。
sh1 = Sheets("入力")
sh2 = Sheets("データ")
sh3 = Sheets("条件")
sh4 = Sheets("検索") ← ★作業シート(Sub 検索()で使用）
sh5 = Sheets("集計") ← ★作業シート(Sub 集計()で使用）
sh6 = Sheets("出向名") ← ★設定シート（リストが記載されている）
sh7 = Sheets("グラフ")
（マリオ） 2016/03/18(金) 21:14
To β さん
すいませんm(_ _)m。転記006.xlsxですが、自分でも見直すのがしんどいコードになっていました。 ★β先生が、見てもええかな〜って感じのときに、【転記009.xlsx】を覗いてもらえれば幸いです。
http://ww10.puny.jp/uploader/download/1458302295.zip
転記009.xlsx (zipファイル)【ダウンロードパスワード: abc 】
コードの主の部分は、Module1だけに書いています。 module2,module3,シートモジュールに書いたコードは、おまけです。
Sub 検索()、Sub 集計()、それぞれのコードの終わりの方で、 【不要になった シートを削除する】 「sh.Delete」 がありますが、 ★この「sh.Delete」の先頭に「'」をつけてコメント化すれば、何をしているのか、よく分かると思います。
■簡単ではありますが、コードの主の部分の説明です。
登録()では、入力シート → データシートへの転記。
検索()では、入力シート → （作業シート：検索シート） → 条件シートに検索結果を表示。
集計()では、入力シート → （作業シート：集計シート）
→ グラフシートに日付ごとの結果（出動回数の合計、人員の合計）を表示。
集計()のコードですが、もっといいやり方があるような気がします。
★βさんに特に見て頂きたいのは、この集計()のコードです。
以前の転記006.xlsxでは、読み込むのがしんどいコードになってましたが、
転記009.xlsxでは、少しは、改善されたかな…？
★2016/03/16(水) 20:03のβさんの記事を読み返してみました。 ＞イベント連鎖が発生しますね。この構成はいただけないなぁ・・・
【条件シート】のシートモジュールのChangeイベントコードにおいて、 ★Case "$G$4"ですが、βさんだったら、どのようにコードを書くのでしょうか？
************************************************************************************************************
■条件シートのシートモジュールのChangeイベントコードでやりたいこと。
Case "$E$4"
・出向名1が変更されたとき、出向名2を初期化（空白に）したい
Case "$F$4"
・これはなくても、いいのだけれど、出向名1が空白のとき、出向名2に手入力で文字が入力されたら、
出向名2に入力された文字を空白にしたい。
Case "$G$4" 本来、G4は、データシートの「G4セル」のように「データの入力規則」にて、 「入力値の種類」を「整数」、「データ」を「次の値以上」、「0」とすれば、コードを記述する必要はないのですが、
プルダウンリストを使いたいので、「入力値の種類」を「整数」ではなく「リスト」にしてみた。 なお、リスト以外の整数も使えるようにしたいので、「データの入力規則」のエラーメッセージTabにて、 「無効なデータが入力されたらエラーメッセージを表示する」のチェックを外しています。 「リスト」を選択したので、、「データの入力規則」にて、正の整数及びゼロ判定ができないので、 Changeイベントコードで、正の整数及びゼロ判定をすることになりまして…。ん〜。 ************************************************************************************************************
（マリオ） 2016/03/18(金) 21:14
あらら。。。
いろいろとすみません。
本当にありがとうございます。
これから、このコード全ての意味を理解できるように
じっくり勉強します！！
（くりた） 2016/03/18(金) 21:29
To くりた さん
＞これから、このコード全ての意味を理解できるように じっくり勉強します！！
しっかりね〜(^^♪ ちょっと、やりすぎなとこもあるんで、βさんに怒られそう(#^^#)
★「Stop」、「Debug.Print」、「MsgBox」のコード、
★キーボードの「Break」キー は知ってますか？
コードを読み込むときに、私は使ってま〜す。
調べてみて、分からなかったら、聞いてね！
（マリオ） 2016/03/18(金) 21:37
To くりた さん
Sub データシート_末尾()ですが、次のように訂正してください。記載する行が逆でした。
（訂正前）
If mx < 4 Then End
mx = sh2.Range("A" & Rows.Count).End(xlUp).Row 'A列で最終行を判断
（訂正後）
mx = sh2.Range("A" & Rows.Count).End(xlUp).Row 'A列で最終行を判断
If mx < 4 Then End
くりたさんへのお手伝いも、これで終了かな？ （マリオ） 2016/03/18(金) 22:55
お礼文
マリオさんには手取り足取り、お手伝いというより
もはやデータ全体を作っていただいて本当に感謝しています。（申し訳なさ半分）
今回の件で改めてエクセルの深さと楽しさを教えていただきました。
そして、少しかじっただけの私の知識とマリオさんの深い知識の圧倒的な差を感じました。
これからは、このデータを素により深く勉強してマリオさんの足元ぐらい見れるようになりたいです。
本当にありがとうございました。
本音文
職場にて。。。
上司 ：おい、くりた。年度末までにこのデータ作れ。
くりた：。。。。はい（まぢか。こんなん無理やろ。無茶ブリ鬼上司め）
あーだめだ。
エクセルの本買って独学しても、デバック祭りやんか。ありえん。
こんなん絶対期日間に合わんやろ。
ネットでいろいろ調べる。
そして。。。『エクセルの学校』登場
キタこれ。
ここに質問すればきっとヒントがもらえる！！
神降臨。
マリオ様登場。
マリオ様は死にかけのくりたに温かい手を差し伸べる。
そして、アドバイスをくれるのです。
・・・オーマイガー。
なんとマリオ様は外国語を話し、言葉が通じません。
（知識の差でくりたにはさっぱりわからなかっただけ笑 もはや日本語には聞こえなかった。）
そして、マリオ様はこれも乗りかかった船。仕方なくデータを作ってくれるのです。
なんともなんとも情けない話でございます。
しかし、くりたは思うのです。
俺も外国語を話したい。
いや、話す。
そんなこんなで、、、
マリオさん
本当にありがとうございましたーーーーーーーーーーーー。
（くりた） 2016/03/18(金) 23:56
To くりた さん
どういたしまして。おせっかいで作成しました。 VBAを利用して、少しでも、仕事が楽になったらいいですね。
ダメ押しで、もういっちょ(#^^#) 転記010.xlsx (zipファイル)【ダウンロードパスワード: abc 】 http://ww10.puny.jp/uploader/download/1458404084.zip
■修正箇所 ・条件シートの「検索結果A列」に「No.」を追加 ・出向名シート → リストシート ・案シートに、「色設定」ボタン、「色解除」ボタンを置いてます。 （手入力箇所、数式入力箇所）のセルを色を付けて塗りつぶし
******************************************************************* 仕事で使われるのですよね。念のため、言っておきます。 ・免責事項 プログラム（転記001.xlsm〜転記010.xlsm）を使用した結果生じる いかなる損害に対しても一切責任を負いません。 ******************************************************************* ご自身で、どんなコードになっているか確認してください。
エクセルの学校 https://www.excel.studio-kazu.jp/
Excel Q＆Aさろん(VBA) http://excelfactory.net/excelboard/excelvba/excel.cgi
moug（モーグ） http://www.moug.net/faq/viewforum.php?f=2 *******************************************************************
P.S 鬼上司には、まだデータは作成できないと、嘘をついておきましょう！
（マリオ） 2016/03/19(土) 20:01
失礼します
TO マリオさん
最近は新規質問がなかなかあがってこない、閑散とした板ですけど、
Excel VBA 質問箱?W
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=tpc;id=excel
といったものもあります。ご参考まで。 （ただでさえ、忙しいマリオさんが、ますます忙しくなって過労でたおれることにならないよう、いのってます？）
（β） 2016/03/19(土) 20:20
To くりた さん
老婆心ながら、くりたさんが かかれた お礼文、本音文 みたいなシナリオをもう１つ。
上司）こないだ頼んだあれ、どうなった？ くりたさん） はい、なんとか。これでいかがですか？ 上司) わぉ！！すごいじゃないか。どうしたんだ。 くりたさん） まぁ、いろいろ勉強もしまして、はい。 上司）よくやった！
数日後
上司） お〜い、くりたぁ。お得意先に、これ見せたら、すごく感心して、これってどこかのベンダに作らせたんですか、高かったでしょうと。 いやいや、くりたってのがいまして、彼、結構優秀で、これぐらいのものなら1週間もあればちちょいなんですよ。 そういったら、あちらの業務で、これこれこんなことがしたい、くりたさんにプログラムを作ってもらえないかと。 わが社の最大の客先でもあるし、わかりました。大船に乗った気持ちでどうぞ。1週間お待ちください。 こういってきたよ。たのんだぞ。これ、先方から渡された要件書。 くりたさん） はい、まかしておいてください！
で、『学校』に質問アップし、マリオさ〜ん お願いしま〜す。
あぁ、なんという不運、マリオさんはインフルエンザでダウン中。
１週間がすぎ、2週間がすぎ・・・・客先から、まだかまだかの催促の嵐。 上司は、ひたすら客先にペコペコ。 会社では、くりたさんに、白い目で・・
といったことがないように祈っています。
★もちろん、本音文でコメントしておられる
>>ここに質問すればきっとヒントがもらえる！！ >>そして、アドバイスをくれるのです。
ということで、基本的には、くりた さんとしては、マリオさんのコードをすべて自分のものとして 理解・吸収しているなら、↑のシナリオは無礼千万なものであり、おわびします。
（β） 2016/03/19(土) 21:17
To β さん
Office TANAKA 掲示板 といったものもあります。ご参考まで。 http://officetanaka.com/patio/patio.cgi
えっと、学校の方ですが、そろそろ長い休学（卒業？）しますm(_ _)m （マリオ） 2016/03/19(土) 22:28
解決したようですが、閲覧者としてひとこと。
（回答者さん） > エクセルファイルを次のどちらかのURL先でアップしてみては？個人情報を削除してから。 ↓ （質問者がアップ） ↓ > ダウンロードしたので、削除しても構いませんよ。
データ（コード）を特定の方だけの間でやりとりするのはやめたほうが良いと思う。 それは個人的な業務請負であるし、それを公衆の面前でするのはいかがなものかと思う。
こうした個人間のデータのやりとりは、こちらの掲示板の趣旨にそぐわないと思うし、 あとからこのスレッドを読む方がいても、何が何だかさっぱりわかりません。 できるだけこのスレッドの中で情報を充足してもらうことが必要だと思います。
（γ） 2016/03/20(日) 00:34
>> ★Case "$G$4"ですが、βさんだったら、どのようにコードを書くのでしょうか？
【休学】前にごらんになるかなぁ？
私の場合は、何も考えず、Changeイベントの最初で、Application.EnableEvents = False プロシジャを抜ける前に 必ず Application.EnableEvents = Treu を記述します。
マリオさんがよく書かれる通常の処理で、コードの先頭に ScreenUpdating とともに EnableEvents、Calculation の 手当てをしておられますよね。 それと同じことですね。
（β） 2016/03/20(日) 17:17
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.