こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

複数行を最終行に転記

ブックから他ブックへの複数行を最終行に転記したいと考えております。
1日1行であれば転記出来るものの、1日が複数行となると1日の最終行のみが転記され困っております。

縦カレンダー仕様
・月初ではなく日曜始まりの為前月含むこともあり
・1日につき各4行づつ
・4行すべて毎日データーが入るわけではなく時々入る程度

スケジュール表仕様
・日曜始まりの一週間毎のシート
・1日につき9行分

1か月分だと長いので1週目分だけですが…
Activ bookを縦カレンダー(入力用シート)
Thisbookをスケジュール表(転記先シート)



Sub 転記_Click()

Dim WBK1 As Workbook,WBK2 As Workbook
Dim SH1 As Worksheet,SH2 As Worksheet
Dim myRow1 As Long,myRow2 As Long,myRow3 As Long,myRow4 As Long_
myRow5 As Long,myRow6 As Long,myRow7 As Long

Set WBK1 = ThisWorkbook '縦カレンダー
Set WBK2 = ActiveWorkbook 'スケジュール表
Set SH1 = WBK1.Worksheets("1週目") 'スケジュール表
Set SH2 = WBK2.Worksheets("3月") '縦カレンダー
Set SH3 = WBK1.Worksheets("2週目") 'スケジュール表
Set SH4 = WBK1.Worksheets("3週目") 'スケジュール表
Set SH5 = WBK1.Worksheets("4週目") 'スケジュール表
Set SH6 = WBK1.Worksheets("5週目") 'スケジュール表
Set SH7 = WBK1.Worksheets("6週目") 'スケジュール表

With SH1
myRow1 = SH1.Range("C1").End(xlDown).Row '日
myRow2 = SH1.Range("C12").End(xlDown).Row '月
myRow3 = SH1.Range("C23").End(xlDown).Row '火
myRow4 = SH1.Range("C34").End(xlDown).Row '水
myRow5 = SH1.Range("C45").End(xlDown).Row '木
myRow6 = SH1.Range("C56").End(xlDown).Row '金
myRow7 = SH1.Range("C67").End(xlDown).Row '土

SH1.Range("C" & myRow1 + 1 & ":J" & myRow1 + 1).Value = SH2.Range("C3:J6").Value '日
SH1.Range("C" & myRow2 + 1 & ":J" & myRow2 + 1).Value = SH2.Range("C7:J10").Value '月
SH1.Range("C" & myRow3 + 1 & ":J" & myRow3 + 1).Value = SH2.Range("C11:J14").Value '火
SH1.Range("C" & myRow4 + 1 & ":J" & myRow4 + 1).Value = SH2.Range("C15:J18").Value '水
SH1.Range("C" & myRow5 + 1 & ":J" & myRow5 + 1).Value = SH2.Range("C19:J22").Value '木
SH1.Range("C" & myRow6 + 1 & ":J" & myRow6 + 1).Value = SH2.Range("C23:J26").Value '金
SH1.Range("C" & myRow7 + 1 & ":J" & myRow7 + 1).Value = SH2.Range("C27:J30").Value '土
  End With
End Sub

投稿日時 - 2016-02-18 12:26:49

QNo.9130015

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

人間では(プログラムを考えなければ)直感的にわかるが、VBAでは複雑になりそうに思う。
私の提案
「スケジュール表」、「縦カレンダー」ともA列には日付(日付シリアル値に限る。表示形式は日だけでもよい)を入れてほしい。
すると、「スケジュール表」の、ある週のこのシートの日付のWEEKNUM値は同じである日付だけになる。
ーーー
疑問
「縦カレンダー」は月ごとらしいが、月初日が日曜から始まらない場合は、どちらの月に入れるのか?たとえば2016年3月は1日が火曜日だが、2月シートに入れるのか、または2月28日(日)から3月に入るのか。
どちらのシートに持っていくのかな。
こういうのは仕様的にむつかしくなると思う。
どちらかに決めても、常識として定着しておらず、使う方も、どちらのシートにあるのか迷うのではないか。
ーーー
上記は小生が質問内容を誤解していたら、補足しておいてください。
勿論、既出のご回答(VBA)でOKだったなら補足する必要はなく、締め切ってください。
---
また
他ブックのシートや同一のブックの他シートに、データを持っていく(移動でなくコピーと思うが)
・各行の代入法の行数分繰り返しではなく
・セル範囲のデータのコピーと貼り付けを使うと、コードの行数が少なくなるのではないか。

投稿日時 - 2016-02-20 17:54:47

ANo.2

小生だった(小生の質問を読んでの理解では)ら、質問は下記のように書く。
コードなど載せない。
勉強と思って読んで、下記で言っていることことを考えてみてください。
小生の質問の理解が間違っている場合は補足してください。
VBAコードを考えるとか、質問する前に自分で考えたり、読者に説明することがあるのではないか。
(A)1週間のスケジュール表が集まったBOOK1つ
   各週分は1シートになっている(分かれている)
   1週は日曜日から土曜日まで。
   月を越えても、同じブック内のシートに記録していくのかな??
(B)月間スケジュール表
   質問では「縦カレンダー」と称す。月を越えて(A)を縦方向に累積する。
   決めた1シートに累積する。
   月を越えても、同じ1つのシートに累積していくのかな??。
この質問は(A)の、あるシートから、(B)の最終行の次行以下に転記(累積)していく
課題らしい。
ーー
以下のことが書いてないようだが、システム的考慮が質問者には不足してないか。
それは作業単位が書いてないではないか?
移す作業の単位は(前)日、(前)週、(前)月分(または随時)のどれか?
どうも週単位らしいがいかがか?
累積作業を忘れることは考えなくてよいのか?
ーー
スケジュール通りに前(日、週、月、回)までは、転記作業が終わっているのは確実といえるのか。
それをきっちりしないとある週分データが飛んで累積されたりするよ。
ーー
小生のお勧めの思い付き
質問者は週単位にこだわっているようなので、WeekNum関数のことを知っているか。
エクセル関数やVBA関数にはWEEKDAYNUM関数があり、スタート曜日が日曜か月曜か選べる。
これを使って(B)の(累積していっている1)シートの最終行!(前回の持ってきた最近の週)の日付のWEEKDAYNUMの数を、知り、それに+1したWEEKDAYNUMのスケジュール記録のある(A)の中のシートを探す。見つかればそのシートの全行(見出しなど除く)をCopyして、(B)のデータの最終行の次行以下に貼りつける(Pasteする)。
1週間飛んでいる場合は、次の週も割り出さないといけないが、工夫すれば、累積を忘れていても自動で補うことは可能ではある。
以上でよければコードを考えてみるが、データ例が作りにくいので面倒です。質問者でやってほしいが。

投稿日時 - 2016-02-18 17:36:10

補足

(A)月を越えても、同じブック内のシートに記録していくのかな??
→1か月毎です。
ーー
(B)月を越えて(A)を縦方向に累積する。
→これも1か月分のみです。
ーー
作業単位が書いてないではないか?
→翌月予定の表になりますので、1日づつでも1週間づつでも構いません。
ーー
累積作業を忘れることは考えなくてよいのか?
→1か月分入力が終わると(B)月間スケジュール表は変更せずそのまま1年保存になります。
(A)1週間のスケジュール表が集まったBOOK1は、変更の際に直接このブックに入力して変更となりその月が終わると年単位で保存になるので、転記でつかわれるのは1回のみです。
A・B共に原本を用意しておき1か月毎にVBAの記載のある新しいブックを使い入力していく予定ですがそれでも累積作業は必要でしょうか。
ーー
スケジュール通りに前(日、週、月、回)までは、転記作業が終わっているのは確実といえるのか。
→申訳ありません、おっしゃって下さっている意味が分かりません。

今月初めに会社役員(PCを打つのに人差し指のみで打つ人)が自分もしたいと言い出して手を出しデーターが没になり、それを直すのに時間を取られ…コピー貼り付け作業ですら聞きに来られると仕事がままならないので、打ちさえすればB→Aブックにボタン一つで転記できるようにしたいと思っている次第です。
ちなみに私もPC初心者で、先日エクセルにこんな機能(VBA)があるんだと知ったレベルです。

投稿日時 - 2016-02-18 21:06:24

ANo.1

一例です。
月のシート名を自動で指定する為に1週目のB1データから数値を取得、日付データであるとしてmonth関数としています、整数で指定の場合はmonth関数削除し、B1の値を使用して下さい。

6周目が無い月は値をコピーしないようにしています。
6周目シートのA3が10以下であれば6周目は不要としました。
A3の値が日付であると思いday関数で日にちを取得しています。整数で対応している場合はday関数を削除して下さい。

Sub test()

Dim WBK1, WBK2 As Workbook
Dim SH1, SH2 As Worksheet
Dim myRow1 As Long
Dim i, j, k, tuki As Integer

Set WBK1 = ThisWorkbook '縦カレンダー
Set WBK2 = ActiveWorkbook 'スケジュール表

'月を整数で取得
tuki = Month(WBK1.Worksheets("1週目").Range("B1").Value)


'6週目が翌月から開始されてる場合は5周で終了
If Day(WBK1.Worksheets("6週目").Range("A3").Value) < 10 Then
k = 5
Else
k = 6
End If

Set SH2 = WBK1.Worksheets(tuki & "月") '縦カレンダー

myRow1 = 3

With SH2

For i = 1 To k

Set SH1 = WBK2.Worksheets(i & "週目")

j = 3

For k = 1 To 7
.Range("C" & myRow1 & ":J" & myRow1 + 3).Value = SH1.Range("C" & j & ":J" & j + 3).Value

myRow1 = myRow1 + 11
j = j + 4

Next

Next

End With

End Sub

投稿日時 - 2016-02-18 16:19:26

あなたにオススメの質問