
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Column <> 1) And (Target.Column <> 5) Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Now()
End Sub
上記のスクリプトで
「1列目にナンバーを記入すると2列目に、5列目にナンバーを記入すると6列目に時刻が自動的にセルに入る」ようになっています。
これに追加で
「5列目にナンバーが記入されると、そのナンバーと同じものを1列目から探し出して、1列目のセルの色を薄い青にする。なければなしとアラートを出す」
ように改造したいのですが
どうすればいいでしょうか?
どうかお願いいたします。
No.5ベストアンサー
- 回答日時:
#02です。
レスポンスありませんね。複数のセルを同時に更新したり、オートフィルで複数のセルに同時に異なる値をセットしてもそれなりに動くようにしてみました。
セルを空白にしたときの動作などを付け加えましたので多少行数が多くなっていますが、ご参考まで。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim psw1, psw2 As Boolean
Dim rngA, rng, r, trg As Range
Set rngA = Intersect(Target, Columns(1))
Set rng = Intersect(Target, Columns(5))
If rng Is Nothing Then
Set rng = rngA
If rng Is Nothing Then Exit Sub
Else
If Not rngA Is Nothing Then
Set rng = Application.Union(rngA, rng)
End If
End If
On Error GoTo end0
Application.EnableEvents = False
Application.ScreenUpdating = False
Columns(1).Interior.ColorIndex = xlNone
For Each r In rng
If r.Value = "" Then
r.Offset(0, 1).ClearContents
Else
If IsNumeric(r.Value) Then
r.Offset(0, 1).Value = Now
If r.Column = 5 Then
psw1 = True
Set trg = Columns(1).Find(What:=r.Value, LookIn:=xlValues)
If Not trg Is Nothing Then
Set trg = Columns(1).FindPrevious(trg)
trg.Interior.ColorIndex = 24
psw2 = True
End If
End If
End If
End If
Next r
If (psw1 = True) And (psw2 = False) Then
MsgBox "A列に更新数値セルと同じ値はありません"
End If
end0:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
ご質問があれば回答しますが、どこが分からないか具体的に書いていただけると助かります。ただ「解説してください」はご勘弁をm(_ _)m
ご親切にありがとうございます。
職場で使うものですので運用法など昨日打ち合わせをしました。
ソフトの方に合わせるそうですので使わせていただきます。
本当に深く感謝しております。
No.6
- 回答日時:
#02です。
もしOffice2007をお使いの場合は、途中のFindメソッドを使っている行を以下に変更してください。(LookAt:=xlWhole を追加)
Set trg = Columns(1).Find(What:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
No.4
- 回答日時:
>同じナンバーが複数あるときは最初だけ水色になるようです。
質問を一読して、複数該当が有るか、質問に書いてないのが気になった。初心者はこれが多い。複数有るなら、もうFind、FindNextが全セル初めから最後まで、その列データを総なめして、各セルの値を探すより無い。
該当が唯一と決まっているなら、1つなら、関数でおなじみの
Sub test01()
x = WorksheetFunction.Match("s", Range("A1:A10"), 0)
MsgBox x
End Sub
のようなのも使えるが。
>どうすればいいでしょうか?
一部コードも書いているようだから、人に聞く前に、Find、FindNextのコードは、検索操作をして、マクロの記録を取り、改造することをやるべきだ。そうすれば疑問点は限られたものになる。
ーー
余り熟練者で無いのに、イベントに頼ってコードを書くべきでない。
本件でも元データが変更されたときなど、該当分を元に戻すなどを考えると苦労するよ。元のセルの値は教えてくれない。
No.3
- 回答日時:
Dim erng As Range
fstAddress = frng.Address
Do
frng.Interior.Pattern = xlNone
Set frng = .FindNext(frng)
If fstAddress <> frng.Address Then
Set erng = frng
End If
Loop While fstAddress <> frng.Address
erng.Interior.colorIndex = 33
ありがとうございます。
同僚の仕事の管理が煩雑になっていまして
していただいたご回答で助かると思います。
ポイントに差が付いてしまいましたが
20差し上げたかったです。
本当にありがとうございました。
No.2
- 回答日時:
複数のセルが同時に更新された場合はどうすればよいですか?
特にオートフィルで複数のセルに異なる値が1回の操作で入力されたらどうなるのが正解なのでしょう??
深く考えると色々難しくなるので、とりあえず複数のセルが更新されたら処理をスキップするようにしてみました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cnt As Long
Dim trg As Range
If Target.Cells.Count > 1 Then
MsgBox "複数のセルが同時に更新されました"
Else
If IsNumeric(Target.Value) Then
On Error GoTo end0
Application.EnableEvents = False
Select Case Target.Column
Case Is = 1
Target.Offset(0, 1).Value = Now()
Case Is = 5
Target.Offset(0, 1).Value = Now()
cnt = WorksheetFunction.CountIf(Columns(1), Target.Value)
If cnt > 0 Then
Set trg = Columns(1).Find(What:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
For idx = 1 To cnt
If idx = cnt Then
Columns(1).Interior.ColorIndex = xlNone
trg.Interior.ColorIndex = 24
End If
Set trg = Columns(1).FindNext(trg)
Next idx
Else
MsgBox "A列に同じ値はありません"
End If
End Select
End If
End If
end0:
Application.EnableEvents = True
End Sub
No.1
- 回答日時:
下記のようなことでどうでしょうか。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim frng As Range
If (Target.Column <> 1) And (Target.Column <> 5) Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Now()
If Target.Column = 5 Then
With Columns("A:A")
Set frng = .Find(Target.Value, .Cells(.Count), xlValues)
End With
If frng Is Nothing Then
MsgBox "Not Found!", vbExclamation
Else
frng.Interior.colorIndex = 33
End If
End If
End Sub
この回答への補足
さっそくありがとうございます。
見てみましたが
同じナンバーが複数あるときは最初だけ水色になるようです。
同じナンバーが複数ある時は最後というか一番下にだけ水色にするようにしたいです。
どうかお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
首吊りどこ締めるの
-
検便についてです。 便は取れた...
-
リンク先のファイルを開かなく...
-
Excel 数値の前の「 ' 」を一括...
-
VLOOKUP関数を使用時、検索する...
-
EXCELで条件付き書式で空白セル...
-
コロナでもインフルでもなかっ...
-
2つの数値のうち、数値が小さい...
-
小数点以下を繰り上げたものを...
-
病院側から早く来てくださいと...
-
MIN関数で空白セルを無視したい...
-
彼女のことが好きすぎて彼女の...
-
血液検査の結果が悪くefgrの値...
-
エクセルで空白セルを含む列の...
-
エクセルで数式の答えを数値と...
-
EXCELで式からグラフを描くには?
-
【Excelで「正弦波」のグラフを...
-
値が入っているときだけ計算結...
-
腕を見たら黄色くなってる部分...
-
風俗店へ行く前のご飯
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
首吊りどこ締めるの
-
検便についてです。 便は取れた...
-
血小板増加について
-
彼女のことが好きすぎて彼女の...
-
Excel 数値の前の「 ' 」を一括...
-
病院側から早く来てくださいと...
-
VLOOKUP関数を使用時、検索する...
-
腕を見たら黄色くなってる部分...
-
値が入っているときだけ計算結...
-
リンク先のファイルを開かなく...
-
2つの数値のうち、数値が小さい...
-
風俗店へ行く前のご飯
-
小数点以下を繰り上げたものを...
-
一番多く表示のある値(文字列...
-
MIN関数で空白セルを無視したい...
-
勃起する時って痛いんですか? ...
-
エクセルで空白セルを含む列の...
-
増減表のプラスマイナスの符号...
-
【Excelで「正弦波」のグラフを...
-
エクセルで数式の答えを数値と...
おすすめ情報