エクセルＶＢＡの記述

質問

エクセルシートで教えてください。
Sheet1 に入力用シートを作成して、Sheet2 にデータを表示されるようにするには、どの様にＶＢＡを記述したらよいでしょうか？
説明
Sheet1 の入力は、日付と入退出の時間です。同日に二回・三回入室すると、同じ日付が二行・三行になります。
Sheet2 の表示は、列が１０分単位で２４時間表示です。行が１日から３１日までの日付です。
サンプル画像のように、Sheet1 に入力した場合に、Sheet2 に赤色で滞在時間を表示するには、どうすればよいでしょうか？
Sheet2 のひとつのセルは１０分です。

回答No.5

hige_082 · ベストアンサー

禁止事項は読まれましたか
特に「丸投げ・依頼」の項目

上のようなルールがあるので、エラー処理、解説は省きます

Sub test()
Dim i As Integer
i = 6
Do Until Worksheets(1).Cells(i, 3) = ""
With Worksheets(1)
Worksheets(2).Range(Cells(.Cells(i, 3) + 6, (.Cells(i, 4) * 144) + 3),Cells(.Cells(i, 3) + 6, (.Cells(i, 4) * 144 + 3) + (.Cells(i, 5) - .Cells(i, 4)) * 144 - 1)).Interior.ColorIndex = 3
End With
i = i + 1
Loop
End Sub

と、言っても、実際は一行で出来る処理なんだけどね、後は繰り返すだけ

＞条件書式では、三つまでしか設定できません。サンプル画像のように、入力する日付は決まってなく、時間もバラバラとなるとＶＢＡで記述しないと難しいのではないかと思います。
やり方によっては、出来ると思うよ

お礼

ＶＢＡ初心者で「丸投げ」になってしまいすいません。
Do Until～Loopを初めて知りました。大変勉強になりありがとうございました。
最初に教えていただいたＶＢＡを記述したところ、データの表示にズレがありましたが、 (.Cells(i, 4) * 144) + 3)の部分を (.Cells(i, 4) * 144 + 3)）に修正したら無事できました。

回答No.4

某HN クロメート(Chromate)（@CoalTar）

VBAということなので無視していただいても結構です
条件付き書式でもできるのでは？ ってことでの回答です
入力してあるデータが読み取れないので推測ですm(_ _)m

G,H列を作業列とします

1. G5:H5セル 0

2. G6セル =$C6+D6
　　 右へ下へオートフィル

3. K6セルから範囲指定して

4. 条件付き書式
　　 数式が =MATCH($J6+K$5,$G$5:$G$10)<>MATCH($J6+K$5,$H$5:$H$10)

お礼

条件付き書式も色々複雑な入力があるのですね。
大変勉強になりました。ありがとうございました。

回答No.3

mt2008

No.2です、Sheet1の読み込みが1列ずれていました。
失礼しました。

誤
　　If Cells(nReadRow, 2) = "" Then Exit Do '空行なら終了
　　'Sheet2の塗りつぶしエリアの左上はC7、C列が0:00、D列が0:10、EO列が翌0:00
　　nPaintRow = Cells(nReadRow, 2) + 6 '塗りつぶす行
　　nStart = Int(Cells(nReadRow, 3) * 144) + 2 'シリアル値に144(=24*6）を掛けて0時から数えて何十分かを演算
　　nEnd = Int(Cells(nReadRow, 4) * 144) + 2

正
　　If Cells(nReadRow, 3) = "" Then Exit Do '空行なら終了
　　'Sheet2の塗りつぶしエリアの左上はC7、C列が0:00、D列が0:10、EO列が翌0:00
　　nPaintRow = Cells(nReadRow, 3) + 6 '塗りつぶす行
　　nStart = Int(Cells(nReadRow, 4) * 144) + 2 'シリアル値に144(=24*6）を掛けて0時から数えて何十分かを演算
　　nEnd = Int(Cells(nReadRow, 5) * 144) + 2

お礼

ＶＢＡを記述しましたが、表示時間に少しズレがありました。
入力開始と終了のＶＢＡは少し理解できたのですが、
塗りつぶしの開始と終了が難しく今後も勉強したいと思います。
ありがとうございました。

回答No.2

mt2008

時間の塗りつぶしだけ、ヒントになりそうなコードを……
エラー処理等入っていません、あくまでもサンプルです。

Sub Sample()
　Dim nReadRow As Long　'Sheet1の入力表を読み込む位置(行）
　Dim nPaintRow As Long 'Sheet2の塗りつぶす位置(行）
　Dim nStart As Integer 'Sheet2の塗りつぶし開始位置(列）
　Dim nEnd As Integer　 'Sheet2の塗りつぶし終了位置(列）

　Application.ScreenUpdating = False '画面の更新停止
　nReadRow = 6　'入力表がC6から始まっている
　'入力表を上から順番に読んで行き、空行があったら処理を終了する
　Do
　　Sheets("Sheet1").Select
　　If Cells(nReadRow, 2) = "" Then Exit Do '空行なら終了
　　'Sheet2の塗りつぶしエリアの左上はC7、C列が0:00、D列が0:10、EO列が翌0:00
　　nPaintRow = Cells(nReadRow, 2) + 6 '塗りつぶす行
　　nStart = Int(Cells(nReadRow, 3) * 144) + 2 'シリアル値に144(=24*6）を掛けて0時から数えて何十分かを演算
　　nEnd = Int(Cells(nReadRow, 4) * 144) + 2
　　If nEnd < nStart Then nEnd = nEnd + 144 '退出が日を跨いだ場合用

　　Sheets("Sheet2").Select
　　Range(Cells(nPaintRow, nStart), Cells(nPaintRow, nEnd)).Select
　　With Selection.Interior
　　　.ColorIndex = 3 '色はとりあえず赤
　　　.Pattern = xlSolid
　　End With

　　nReadRow = nReadRow + 1
　Loop
　Application.ScreenUpdating = True
End Sub

回答No.1

riveron77

セルに式を埋め込む、では駄目なんでしょうか？「Sheet1」の「A1」のデータを表示したいセルに「=Sheet1!A1」と入力するとできます(ご存知かもしれませんが)。

「赤くする」については以下のURLをご参照ください。
【Excel(エクセル)基本講座：条件付き書式の使い方】
http://www.eurus.dti.ne.jp/~yoneyama/Excel/jyo-syo.html

補足

条件書式では、三つまでしか設定できません。サンプル画像のように、入力する日付は決まってなく、時間もバラバラとなるとＶＢＡで記述しないと難しいのではないかと思います。