マクロでシート同士の転記をしたい

Question

マクロを使って、「Sheet1」から「Sheet2」に、以下のように転記したいです。
Sheet2ではSheet1の日付セルの最大値と最小値を取得し、１ヶ月ごとに羅列します。

そこでさらに別のマクロで以下の２点を実装したいです。

・担当者をC列に転記していきます。（重複するものは転記しない）
・各担当者の行の数字を転記していく。（この時、年月日が重複する場合は加算する）

何卒、よろしくお願いします。

Comments

[kuma_kuma_]

質問者様
処理を小出しにしてますが、もうこれは「作成依頼」と変わりません。
「やってほしいことだけを記載した丸投げの質問」に抵触します。

あと以前と別ユーザで入られていますよね？悪質ですよ

[ttyp03]

コード提示されてますが、中身ないじゃないですか。
丸投げと同じですよ、これは。

Answer 1

以下のコードでいかがでしょうか。
「Microsoft Scripting Runtime」へ参照設定してください。

Option Explicit

Const cnsWsh1RowBgn = 2
Const cnsWsh1Col担当者 = 3      'C列
Const cnsWsh1Col年月日Bgn = 4   'D列
Const cnsWsh1Col年月日End = 12  'L列
Const cnsWsh2Row年月日 = 2
Const cnsWsh2RowBgn = 3
Const cnsWsh2Col担当者 = 3      'C列
Const cnsWsh2Col年月日 = 4      'D列

Sub SheetTenki2()
    Dim lngWsh1Row As Long
    Dim lngWsh1RowEnd As Long
    Dim strWsh1担当者 As String
    Dim lngWsh1Col As Long
    Dim datWsh1年月日 As Date
    Dim lngWsh2Row As Long
    Dim lngWsh2Col As Long
    Dim lngWsh2ColEnd As Long
    Dim datWsh2年月日 As Date
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim dctWsh2Row担当者 As Dictionary
    Dim dctWsh2Col年月日 As Dictionary
    Dim var As Variant
    
    Set wsh1 = Worksheets("Sheet1")
    Set wsh2 = Worksheets("Sheet2")
    Set dctWsh2Row担当者 = New Dictionary
    Set dctWsh2Col年月日 = New Dictionary
    
'設定先消去

    wsh2.Range(wsh2.Cells(cnsWsh2RowBgn, cnsWsh2Col担当者), wsh2.Range("A1").SpecialCells(xlCellTypeLastCell)).ClearContents
        
'年月日のDictionaryの設定

    lngWsh2ColEnd = wsh2.Cells(cnsWsh2Row年月日, wsh2.Columns.Count).End(xlToLeft).Column
    For lngWsh2Col = cnsWsh2Col年月日 To lngWsh2ColEnd
        datWsh2年月日 = wsh2.Cells(cnsWsh2Row年月日, lngWsh2Col).Value
        dctWsh2Col年月日(datWsh2年月日) = lngWsh2Col
    Next lngWsh2Col

'担当者のDictionaryの設定

    lngWsh1RowEnd = wsh1.Cells(wsh1.Rows.Count, cnsWsh1Col担当者).End(xlUp).Row
    lngWsh2Row = cnsWsh2RowBgn - 1
    For lngWsh1Row = cnsWsh1RowBgn To lngWsh1RowEnd
        If IsDate(wsh1.Cells(lngWsh1Row, cnsWsh1Col担当者).Offset(, 1).Value) = False Then
            strWsh1担当者 = wsh1.Cells(lngWsh1Row, cnsWsh1Col担当者).Value
            If dctWsh2Row担当者.Exists(strWsh1担当者) = False Then
                lngWsh2Row = lngWsh2Row + 1
                wsh2.Cells(lngWsh2Row, cnsWsh2Col担当者).Value = strWsh1担当者
                dctWsh2Row担当者(strWsh1担当者) = lngWsh2Row
            End If
        End If
    Next lngWsh1Row

'値の加算

    For lngWsh1Col = cnsWsh1Col年月日Bgn To cnsWsh1Col年月日End
        For lngWsh1Row = cnsWsh1RowBgn To lngWsh1RowEnd
            var = wsh1.Cells(lngWsh1Row, lngWsh1Col).Value
            Select Case True
                Case var = ""
                Case IsDate(var)
                    datWsh1年月日 = var
                Case IsNumeric(var)
                    strWsh1担当者 = wsh1.Cells(lngWsh1Row, cnsWsh1Col担当者).Value
                    lngWsh2Row = dctWsh2Row担当者(strWsh1担当者)
                    lngWsh2Col = dctWsh2Col年月日(datWsh1年月日)
                    wsh2.Cells(lngWsh2Row, lngWsh2Col).Value = wsh2.Cells(lngWsh2Row, lngWsh2Col).Value + var
            End Select
        Next lngWsh1Row
    Next lngWsh1Col
    
    Set dctWsh2Col年月日 = Nothing
    Set dctWsh2Row担当者 = Nothing
    Set wsh2 = Nothing
    Set wsh1 = Nothing
    
End Sub

Comments

[kuma_kuma_]

この人にコード丸投げしちゃだめだよ
「やってほしいことだけを記載した丸投げの質問」を繰り返し
指摘を受けると削除してユーザまで変えて再質問を繰り返しているんだから

気をつけないとkitasueさんが違反行為の加担者になってしまいますよ

[kitasue]

https://teratail.com/questions/293303
この質問も私には丸投げに感じますが、kuma_kuma_さんは回答してらっしゃいますよね。
そもそも、丸投げは非推奨行為であって、違反行為ではないのでは。
それとも「非推奨」な質問に回答すると「違反行為に加担」したことになるのでしょうか。

[kuma_kuma_]

まずはここでの丸投げ回答についてですがこんな質問者様だとは思わず答えてしましました。

その時は以前からしつこく書かれていたため今後この様な事が無い様にと
どこがいけないのか、丸投げにならないよう最低限の知識をつけましょう
等半日以上かけて説明して回答してしまいました。

これで丸投げ回答はなくなる。
質問者様も最低限プログラムの知識をえ、
他の方が見た時もこういう点を注意して考えどこを質問すればよいのかという参考になってほしいと
思って行った行為でした。

ただ残念な事にその後も何もコードを提示せずにさらにユーザを変えてまで「丸投げ」状態の質問を繰り返すばかり。
kitasueさんにも同じ目にあってほしくないからこそ書いているのです。

[kitasue]

kuma_kuma_さん、どうもありがとございます。
「違反行為の加担者」という言葉に過剰に反応してしまいました。ごめんなさい。
例えば、「非推奨」な質問なのに、それに回答してしまうと、「非推奨」な質問を助長しかねないから、好ましくないということであれば、それはその通りだと思いますので、今後は控えることにします。
ただ、私の中にあるのは、「自分の興味の持てる質問か否か」だけなのです。質問者に対する教育的な配慮は、あまりありません。
いずれにせよ、この場で語ることではないですね。失礼いたしました。

[kuma_kuma_]

https://teratail.com/questions/293303

こちらについては
追記欄で「文章で書くよりコードにコメント残したほうが書きやすいのですが」と断りを入れ
コード+ロジックの解説という方式をとらせていただきました。
(処理が正しいか検証するためにコードを書かなければならなかった為)
私としては「ロジックの解説」をコードを踏まえ解説しているつもりですが？

ただし過去にはたしかにコード丸投げもしたことがあります。
ここは私の反省点でもあります。

>「非推奨」な質問に回答すると「違反行為に加担」
これに関しては通常の方（特に初心者）などは気が付かないで「やってほしいことだけを記載した丸投げの質問」になっている場合があります。
その様な方を見つけたら私はできるだけ質問の問題点を整理して全部ではなく判らない部分を質問しましょうとアドバイスしています。そういう意味では私も「回答」していますので「違反行為」ととらえていません。

ただ今回の場合は別です。
明らかに悪意がある方法で自分のほしいシステムをタダで取得しようとしています。
もしこんな方法でここに質問するとタダでシステムが手に入るとなったらどうなりますか？
私もよく「自分なら作れる。ソースも簡単だ。そうすればきちんとした回答になる。」という場面が往々にしてあります。基本的な内容で10行程度なら答えるのもいいでしょう。
ただビジネスロジックが含まれる場合は別です。その時点で「システムの作成依頼」になります。
今回の処理も以前からの質問内容からして完全に「ビジネスロジック」です。
(質問を分散して誤魔化していますが)

kitasueさんがとても優しい方で何度でも質問に答えます。という形でひとつずつ回答されるなら別ですが
（そういう意味で以前回答された時は止めませんでした）

このような丸投げ回答が続くと「やってほしいことだけを記載した丸投げの質問」(システムの作成依頼)に対して「無料で全部答える人」となってしまいますよ？その場合「わからない事に対して答える場」というコンセプトから大きく外れ非難されかねないですよ？という気持ちで書いたわけです。

少なからすkitasueさんの書かれたソースはキチンと考慮もされていて素晴らしいものだと思います。
ただ相手をえらばないと大変なことになりますよという事です。

[kuma_kuma_]

すみません。長文書いていたためにお返事と内容が被ってしまいましたね。申し訳ないです。