![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
Excel VBA初心者です。
Worksheet_Changeは既に使われています。
C列に入力すると他の行に一つ上をコピーペースト出来る様にしたいです。
例えばC9列に入力するとG9行からAA9行に一つ上のG8行からAA8行をコピーペーストしたいと思っています。ただ J 列に時間が入ります。どの様にすれば良いのか分からないです。どうか教えて下さいお願いします。
式は、Cに入力するとカーソル移動と時間が出る様になっています
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng, r As Range
Dim i As Integer, j As Integer
If Intersect(Target, Range("C8:C47,F8:F47")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Column = 3 Then
Set rng = Intersect(Target, Range("C8:C47"))
If rng Is Nothing Then Exit Sub
For Each r In rng
If r.Value <> "" Then
Range("J" & r.Row).Value = Format(Now(), "hh:mm")
Elsle
Range("J" & r.Row).'ClearContents
End If
Next r
j = 6
Else
j = 3
End If
For i = 8 To 47
If Cells(i, j).Value = "" Then
Cells(i, j).Select
Exit For
End If
Next i
Application.EnableEvents = True
End Sub
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
G~AA列の入力件数をCountA関数でカウントして、ゼロの場合のみ、コピーをするようにしてはいかがでしょう。
例えば、こんな感じです。
If r.Value <> "" Then
If r.Row <> 8 And _
WorksheetFunction.CountA(Range("G" & r.Row & ":AA" & r.Row)) = 0 Then
Range("G" & r.Row & ":AA" & r.Row).Value = Range("G" & r.Row - 1 & ":AA" & r.Row - 1).Valu
End If
Range("J" & r.Row).Value = Format(Now(), "hh:mm")
ありがとうございます。G行からAA行までは数字ではなく文字入力になるのですが。
こんな感じです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng, r As Range
Dim i As Integer, j As Integer
If Intersect(Target, Range("C8:C47,F8:F47")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Column = 3 Then
Set rng = Intersect(Target, Range("C8:C47"))
If rng Is Nothing Then Exit Sub
For Each r In rng
If r.Value <> "" Then
Range("J" & r.Row).Value = Format(Now(), "hh:mm")
Else
Range("J" & r.Row).Delete 'ClearContents ?
End If
Next r
j = 6
Else
j = 3
End If
For i = 8 To 47
If Cells(i, j).Value = "" Then
Cells(i, j).Select
Exit For
End If
Next i
Application.EnableEvents = True
End Sub
No.3
- 回答日時:
If r.Value <> "" Then
If r.Row <> 8 Then
Range("G" & r.Row & ":AA" & r.Row).Value = Range("G" & r.Row - 1 & ":AA" & r.Row - 1).Valu
End If
Range("J" & r.Row).Value = Format(Now(), "hh:mm")
No.2
- 回答日時:
J列に時刻を設定する直前に、前行をコピーする命令を入れればOKでしょう。
こんな感じです。
If r.Value <> "" Then
Range("G" & r.Row & ":AA" & r.Row).Value = Range("G" & r.Row - 1 & ":AA" & r.Row - 1).Value
Range("J" & r.Row).Value = Format(Now(), "hh:mm")
ありがとうございます。出来ました。すみません言い忘れていました。G8からAA8は一つ上をコピーペーストしない様に出来ないでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) 【再々投稿】VBAのプログラムで動作しなくて困っています 8 2022/10/14 09:06
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Visual Basic(VBA) 【再投稿】VBAで動作しなくて困っています 2 2022/10/11 11:05
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Excel(エクセル) エクセルVBAでオブジェクトが必要です 2 2022/09/10 16:37
- Visual Basic(VBA) VBAで重複した値のセルに色付けをしたい 1 2022/11/02 16:12
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Excel(エクセル) B列に文字がはいったらA列に数字が入るマクロードを完成させたい 4 2023/04/21 01:58
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
塗りつぶしの色をコピーするには
-
空白行を無視してコピーするマ...
-
Excelで行ごとコピー、同じ行を...
-
友達のTV録画したDVD-R( SHARP...
-
googleで翻訳したテキストがコ...
-
コピー&貼り付けの仕方を教え...
-
【エクセル】表の中の文字だけ...
-
Excel VBA初心者です。 Workshe...
-
C+vのvは英語で何の頭文字...
-
大学生です。moodle上でのテス...
-
VBAのテキストボックスに文字列...
-
PDFの一部を切り取って別のシー...
-
Twitterで、いいねしてくれた人...
-
右クリックでコピー、切り取り...
-
OpenOfficeのCalcでコピー出来ない
-
Excel 3列毎のセルを別の表に抽...
-
メモ帳またはTeraPadでのコピー...
-
エクセルでコピーしたものをコ...
-
どなたか3連単の組み合わせが1...
-
Excel フィルターを掛けた状態...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelで行ごとコピー、同じ行を...
-
塗りつぶしの色をコピーするには
-
PDFの一部を切り取って別のシー...
-
C+vのvは英語で何の頭文字...
-
【エクセル】表の中の文字だけ...
-
Excel 3列毎のセルを別の表に抽...
-
VBAのテキストボックスに文字列...
-
セルに値がある行のみを抽出す...
-
WORDのグレー括弧って?
-
セルから一部だけを抜き出して...
-
コピーされたセルの文字が途中...
-
EXCEL 1つ飛ばしのセル参照
-
エクセルでコピーしたものをコ...
-
Word(Offce365)の不思議な現...
-
数式による空白を無視して最終...
-
コピー&貼り付けの仕方を教え...
-
マイナスの場合「xxxx-」...
-
空白行を無視してコピーするマ...
-
【Excel】数式をそのまま他のシ...
-
エクセルでマクロにてセル色と...
おすすめ情報
先にG行からAA行までに入力変更するとC列に入力したらコピーペースト出来ない様にしたいです。
C列に入力時は、J列に時間が、必ず出る様にしたいです。