| |
neptune さん ご回答ありがとうございます。
質問が長すぎて申し訳ありません。
処理に時間がかかるのは、並べ替えなのです。
ただ、これは必要なことだと思っています。
素人でスミマセンが、
Private Sub Worksheet_Change(ByVal Target As Range)
と
Private Sub Worksheet_Activate()
は
一つにまとめられるものでしょうか？
意味合いが違いますか？
まとめられないなら、すぐにあきらめます。
考えているのは、下記の部分だけでもまとめることは出来るものなのかということです。
スミマセンが、教えていただけますでしょうか？
'５行目以降でＥ列に医療機関名を漢字で入力すると、Ｄ列に振り仮名を振り、Ｆ列に"なし"と入力する
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Application.EnableEvents = False
LastRow = Range("E65536").End(xlUp).Row
For R = 5 To LastRow
Set rng = Application.Intersect(Target, Range("E:E"))
If Not rng Is Nothing Then
For Each crng In rng
With crng
.Offset(0, -1).Value = _
Evaluate("asc(phonetic(" & .Address & "))")
End With
Next
End If
If Target.Column = 5 Then
Cells(Target.Row, "F") = "なし"
End If
Next R
Application.EnableEvents = True
End Sub
' シート医療機関がアクティブになった時の処理
Private Sub Worksheet_Activate()
Dim myRange As Range
Dim FindCell As Range
Dim LastRow As Long
Dim LastClm As Integer
Dim R As Long
If Range("F2").Value = "" Then Exit Sub
LastRow = Range("E65536").End(xlUp).Row
For R = 5 To LastRow
Set myRange = Range(Cells(R, "G"), Cells(R, "IV").End(xlToLeft))
If WorksheetFunction.CountIf(myRange, Range("F2").Value) > 0 Then
Cells(R, "B").Value = 0
Else
Cells(R, "B").Value = 1
End If
Next R
If WorksheetFunction.CountIf(Range("B5:B" & LastRow), 1) = 0 Then Exit Sub
LastClm = 5
For R = 5 To LastRow
If LastClm < Cells(R, "IV").End(xlToLeft).Column Then
LastClm = Cells(R, "IV").End(xlToLeft).Column
End If
Next R
Set myRange = Range("A5", Cells(LastRow, LastClm))
myRange.Sort Key1:=Range("B5"), Order1:=xlAscending, _
Key2:=Range("D5"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False
Range("E5").Select
End Sub
|
|
マップー
- 07/2/7(水) 17:15 -
