[[20150225104050]]　『第何週かによって張付ける表を変更したい』（Yuho）　ページの最後に飛ぶ

『第何週かによって張付ける表を変更したい』（Yuho）

先週皆様から教えて頂いたマクロで

 カレンダーのシートをクリックしてマクロを動かし
 曜日別の表を月毎のシートに無事張付けできています。

 Sub Test()
    Dim sh As Worksheet
    Dim shn As String

    If Not IsDate(ActiveCell.Value) Then
        MsgBox "日付が選択されていません"
        Exit Sub
    End If

    shn = Format(ActiveCell.Value, "m月")
    On Error Resume Next
    Set sh = Sheets(shn)
    On Error GoTo 0
    If sh Is Nothing Then
        MsgBox "シート　" & shn & " がありません"
        Exit Sub
    End If

    With sh.Range("A1", sh.UsedRange)
        Sheets("AA").Range("B9:G40").Offset((Weekday(ActiveCell.Value, vbMonday) - 1) * 33).Copy .Range("A" & .Rows.Count).Offset(1)

    End With
    Sheets(shn).Select

  End Sub
 可能であれば、追加で教えて頂きたいのですが
 今、SheetAAのB9:G40を月曜の表とし、下に金曜までの
 表を作成し運用しておりますが、
 実は週ごとに予定表が違い（第１～第5週で）
 表を張付けてから微調整しております。
 そこで、週ごとの表を自働で張付けられないか…と思い
 再々度のお願いでした。
 私的な勝手な構想ですが
 もしActiveCellの日付が第何週なのかが分かれば
 原本シートを5つ用意し（仮に SheetA1～A5）
 1週目はSheetA1から4週目はSheetA4から張付ける…
 という具合にできると、週ごとの特殊性を配慮した
 元表を作成・管理しやすいのですが…可能でしょうか。
 よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 結局日付によってコピー元を変更するだけだと思いますが、第1週の定義はどういった
 内容でしょうか。

 1日が水曜であった場合、７日の火曜は第一週ですか？第二週ですか？
（Mook） 2015/02/25(水) 13:07

Mookさん、ありがとうございます。

 そういえば社内でも、もめたことがありました
 第１週目ではなく、1回目ということです。
 1日が水曜だと7日火曜は「第一火曜」です。
 説明不足で申し訳ありません。
 よろしくお願いします。
（Yuho） 2015/02/25(水) 13:20

 であれば、単純に７で割ればシートを特定できますし、曜日で位置を特定できるかと
 思います。

 コピー元のシート名が AA1 ～ AA5 であれば、
     Sheets("AA").Range("B9:G40").Offset((Weekday(ActiveCell.Value, vbMonday) - 1) * 33).Copy
 を
     numOfWeek = Int((Day(CDate(ActiveCell.Value)) + 6) / 7)
     Sheets("AA" & numOfWeek ).Range("B9:G40").Offset((Weekday(ActiveCell.Value, vbMonday) - 1) * 33).Copy
 のようにしてできないでしょうか。
（Mook） 2015/02/25(水) 13:54

Mookさん　ありがとうございます。

 これから夜まで外勤でPC環境にないため
 後程、提案されたマクロについて試行してみます。
 申し訳ありません。
 少々お待ちを。
（Yuho） 2015/02/25(水) 14:16

Mookさん

 ありがとうございました。
 見事、希望通りに週ごとの予定表が一発でできました。
 これで、何人もの週ごとのスケジュールを手作業でコピペし
 第何週は…と調整していたのが、
 週ごとの原本を作成することで、ワンタッチで
 間違うことなく作成できます。
 １時間以上かかっていた作業がおそらく５分程度で
 しかも間違うことなく出来るようになります。
 本当に助かりました。
 お世話になりました。
（Yuho） 2015/02/25(水) 20:48

コメント返信：

[ 一覧(最新更新順) ]

[[20150225104050]] 『第何週かによって張付ける表を変更したい』（Yuho） ページの最後に飛ぶ

[[20150225104050]]　『第何週かによって張付ける表を変更したい』（Yuho）　ページの最後に飛ぶ