組んでみました(笑)
かなり無理やりですが・・
データが何万もなければそれなりに動くと思います。
PⅢ500MH192Mで1万データで2.3秒でした。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i, Mr As Range
Dim Myrange As Range, Myrange2 As Range
Dim end_r, end_r2
On Error Resume Next
end_r = Cells(Rows.Count, 2).End(xlUp).Row
'台帳B列の最終行
With Sheets("入力リスト")
end_r2 = .Cells(Rows.Count, 2).End(xlUp).Row
'入力リストの最終行
Set Myrange = .Range("B2:B" & end_r2)
End With
If Target.Address = "$A$1" And Target.Value = "文書名が不正です!" Then
Cancel = True
'ダブルクリック無効
Set Myrange2 = Range("B5:B" & end_r)
Range(Cells(2, 2), Cells(end_r, 2)).Interior.ColorIndex = xlNone
'色初期化
For Each Mr In Myrange2
If IsError(Application.Match(Mr.Value, Myrange, 0)) Then
'Match関数でエラーになったら色を塗る
Mr.Interior.ColorIndex = 3
End If
Next
End If
Set Myrange = Nothing
Set Myrange2 = Nothing
End Sub
あと仕事でよくやってるんですが
VBAから式を入れて値にするという方法なんですが
こうすると再計算が起こってもあちこちで再計算しなくて済むので
ファイルが軽くなるというメリットがあります(笑)
よろしければ・・
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'イベント停止
If Target.Column = 3 And Target.Row >= 5 And IsDate(Target.Value) Then
'変更されたセルの列C列で5行目以上で値が有効な日付として認識できれば、式を入れて即座に値に変換
Target.Offset(, -2).Formula = "=""(所 属)""&IF(MONTH(C19)>3,MID(YEAR(C19),3,2),MID(YEAR(C19)-1,3,2))&""-""&IF(C18=""発行日付"",""0001"",IF(IF(MONTH(C18)>3,MID(YEAR(C18),3,2),MID(YEAR(C18)-1,3,2))<>IF(MONTH(C19)>3,MID(YEAR(C19),3,2),MID(YEAR(C19)-1,3,2)),""0001"",TEXT(RIGHT(A18,3)+1,""0000"")))"
Target.Offset(, -2).Value = Target.Offset(, -2).Value
Else
Target.Offset(, -2) = ""
End If
Application.EnableEvents = True
'イベント復活
End Sub
[No.505] 2004/01/28(Wed) 14:53 |
Excel：入力規則について [疑問] - ma2chin - 2004/01/27(Tue) 02:56 [No.491]
└ 