教えて!goo限定 1000名様に電子コミック1000円分が当たる!!

マクロについて教えてください
マクロ素人で分かっておらず詳しく教えて頂けると幸いです。
Private Sub Worksheet_Change(ByVal Target As Range)
'// 対象外の条件は最初にチェック
If Target.CountLarge <> 1 Then Exit Sub '// セルの変更が複数個所だったら終了
If Intersect(Target, Columns("S:U")) Is Nothing Then Exit Sub

Dim r As Long
r = Target.Row

If r Mod 2 = 1 Then Exit Sub
If Cells(r, "S").Value = "" Or Cells(r, "T").Value = "" Or Cells(r, "U").Value = "" Then Exit Sub

'// 変更処理
Application.EnableEvents = False

With ThisWorkbook.Worksheets("ゲート28") '//
' S T U => B C D
.Cells(r, "B").Resize(1, 3).Value = Cells(r, "S").Resize(1, 3).Value
With .Range("E" & r & ":KF" & r)
.ClearContents
.Interior.colorIndex = xlNone
End With
Dim stime As Date
stime = Application.WorksheetFunction.Floor(.Range("B" & r), 1 / 288)

Dim etime As Date
etime = Application.WorksheetFunction.Ceiling(.Range("C" & r), 1 / 288)

Dim sc As Integer
Dim ec As Integer

If stime >= TimeSerial(6, 0, 0) Then
sc = (Hour(stime) * 60 + Minute(stime) - 360) / 5 + 5
ec = (Hour(etime) * 60 + Minute(etime) - 360) / 5 + 5
Else
sc = (Hour(stime) * 60 + Minute(stime)) / 5 + 221
ec = (Hour(etime) * 60 + Minute(etime)) / 5 + 221
End If

.Cells(r, sc).Value = .Cells(r, "D").Value
If r Mod 4 = 0 Then
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.colorIndex = 36
Else
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.colorIndex = 8
End If
End With
Application.EnableEvents = True
End Sub

上記にてセル s t uのセルに入力するとシート ゲート28のシートのセルe c dが動くようになっているのですが、
別のシートにボタンを設けて、
セルS T U の値を、当該シートに一括してコピーするマクロを実行される事が調べてみましたが
よく理解できず出来ません。
やり方を教えて頂けると幸いです。

よろしくお願いいたします。

A 回答 (2件)

こんばんは、


検証する環境などが無いので、ざっくりとしたアドバイスになります。
木曜までレスポンスも期待に応えられないかとおもいます。
まず、記載のシートイベントプロシージャですが、実行ロジックはどこだかわかりますか、
一部離れていますが、
With ThisWorkbook.Worksheets("ゲート28") '//
.Cells(r, "B").Resize(1, 3).Value = Cells(r, "S").Resize(1, 3).Value
With .Range("E" & r & ":KF" & r)
.ClearContents
.Interior.ColorIndex = xlNone
End With
.Cells(r, sc).Value = .Cells(r, "D").Value
If r Mod 4 = 0 Then
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.ColorIndex = 36
Else
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.ColorIndex = 8
End If
End With
ですかね。後のコードは、条件設定や使用変数への代入などですね。

実行部分で使われている変数
r sc ec の sc ec は実行時に数式で値を代入していますが、
r は、Worksheet_Change(ByVal Target As Range)のTargetから
r = Target.Rowで代入しています。つまり、シートで入力した行№ですね。

つまり、ボタンから実行した場合とありますが、この r の値をどうするのか
考えていないように思います。
>一括してコピーする と言う認識で詳細を考えていないのかもしれませんね
このあたりを整理して考えると解決に近づくのではないかと思います。

追加回答できないかも知れないので、あてずっぽのサンプルを書いときます。
掲示されているコードが正しく実行されると仮定しています。
さらに、sc ecがマイナスなどになる可能性のエラーも考慮しません。

標準モジュールに(Module1)

Sub Sample(ByVal Target As Range)
Dim rng As Range
Dim r As Long
' Application.EnableEvents = False
With ThisWorkbook.Worksheets("ゲート28") '//
For Each rng In Target
r = rng.Row
.Cells(r, "B").Resize(1, 3).Value = ActiveSheet.Cells(r, "S").Resize(1, 3).Value
With .Range("E" & r & ":KF" & r)
.ClearContents
.Interior.ColorIndex = xlNone
End With
Dim stime As Date
stime = Application.WorksheetFunction.Floor(.Range("B" & r), 1 / 288)
Dim etime As Date
etime = Application.WorksheetFunction.Ceiling(.Range("C" & r), 1 / 288)

Dim sc As Integer
Dim ec As Integer

If stime >= TimeSerial(6, 0, 0) Then
sc = (Hour(stime) * 60 + Minute(stime) - 360) / 5 + 5
ec = (Hour(etime) * 60 + Minute(etime) - 360) / 5 + 5
Else
sc = (Hour(stime) * 60 + Minute(stime)) / 5 + 221
ec = (Hour(etime) * 60 + Minute(etime)) / 5 + 221
End If
.Cells(r, sc).Value = .Cells(r, "D").Value
If r Mod 4 = 0 Then
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.ColorIndex = 36
Else
.Range(.Cells(r, sc), .Cells(r, ec)).Interior.ColorIndex = 8
End If
Next
End With
' Application.EnableEvents = True
End Sub

Sub button() ’ボタン登録、内容はわからないので直してください。
Dim lastRow As Long
lastRow = ThisWorkbook.Worksheets("ゲート28").Cells(Rows.Count, "S").End(xlUp).Row
Call Sample(ThisWorkbook.Worksheets("ゲート28").Range("S2:S" & lastRow))
End Sub


シートイベントから
Private Sub Worksheet_Change(ByVal Target As Range)
'// 対象外の条件は最初にチェック
If Target.CountLarge <> 1 Then Exit Sub '// セルの変更が複数個所だったら終了
If Intersect(Target, Columns("S:U")) Is Nothing Then Exit Sub
Dim r As Long
r = Target.Row
If r Mod 2 = 1 Then Exit Sub
If Cells(r, "S").Value = "" Or Cells(r, "T").Value = "" Or Cells(r, "U").Value = "" Then Exit Sub
'// 変更処理
Application.EnableEvents = False
Call Module1.Sample(Target)
Application.EnableEvents = True
End Sub

長文になりました。
そもそもコンパイルできなかったりして、、、全く違ったら忘れてください。
    • good
    • 0
この回答へのお礼

ありがとうございます。

とても参考になりました。

詳しい回答をありがとうございます。

まだまだ分からない事ばっかりなので
とても為になりますし、助かりました。


本当にありがとうございました。

お礼日時:2020/09/15 16:51

1です。

投稿後気が付きました。
ボタンからを考えるとこの条件は、必須なので訂正追記します

標準モジュールのSub Sample(ByVal Target As Range)

該当部分とコード
For Each rng In Target
r = rng.Row
’ここから下
If r Mod 2 <> 1 And _
Cells(r, "S").Value <> "" And _
Cells(r, "T").Value <> "" And _
Cells(r, "U").Value <> "" Then
’ここ迄
.Cells(r, "B").Resize(1, 3).Value = ActiveSheet.Cells(r, "S").Resize(1, 3).Value

・省略

’これを忘れずに
End If
Next
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング