不完全な関数やVBAをまとめてVBA化したい

質問

初めての質問と長文で、失礼いたしマス。

　前任者の置きみやげ？の日報（一部不完全な関数とVBAを使用したもの）を職場で日々使ってい　ます。
　最近サイズが大きくなってきたり、使い勝手がいまいちということもあり、すっきりサックリなものにと　改良をしようとしましたが、Excel関数をかじった程度の自分の知識では無理でした。
　この不完全な関数やVBAをまとめてVBA化する、詳しい手順や記述などを教えていただけないで
　しょうか？

　以下、現状と希望や条件などです。　 ～下に画像添付いたします～

　・図／表１の氏名欄（T4、AC4、AL4、AU4、BD4）は、毎日変動します。
　 それぞれ入力規則のリストから選べるようになっています。

　・処理の対象はフォルダ内全ての日報ファイルです。
　 ちなみに、ドキュメント内に各年度フォルダ／各月フォルダ／日報ファイル１（Sheet1～　
　 Sheet10）、日報ファイル２（Sheet11～Sheet20）、日報ファイル３（Sheet21～Sheet31）
　 となっています。

　・原則として、自動入力させるセルは、氏名欄１（T列）、氏名欄２（AN列）、氏名欄３（BJ列）と
　　時刻欄２（W列）、時刻欄３（AQ列）のみです。
　　なお、時刻欄１（A列）と内容欄１（D列）、内容欄２（Z列）、内容欄３（AT列）は手動での入力と
　　なります。

・自動入力させるセルには、VBAの処理を無視した入力も可能にしたいです。
　　※内容欄２（Z列）のみや内容欄３（AT列）のみを入力することがあり
　　　 その際に時刻欄２（W列）、時刻欄３（AQ列）や氏名欄２（AN列）、氏名欄３（BJ列）への
　　　　入力が必要となる為です。

　★氏名欄１（T列）、氏名欄２（AN列）、氏名欄３（BJ列）　について
　 希望として、入力した時刻に該当する"氏名（苗字のみ）"を、図／表１の

　 時間帯(1) 0:00～8:29　(2) 8:30～11:59 (3) 12:00～17:14 (4) 17:15～20:29 (5) 20:30～23:59

　 を参照して自動入力させたいです。

現状は
　・同じ行の内容欄に記述がある場合にのみ"氏名（苗字のみ）"を自動入力。
　・一番上の行や上のセルが空欄の場合には"氏名（苗字のみ）"を入力。
　・"氏名（苗字のみ）"の場合は、"〃"を入力。
　・"〃"が入力されている場合は、"〃"を入力。
となるような下記関数を使用中です。

また、時間帯によって下記関数内の"氏名（苗字のみ）"を置換を使用し変更している状態です。
◎例えば　8:30～11:59　と　17:15～20:29　の入力時には、下記関数内の氏名の箇所を"長谷川"
　　に置き換えています。

　氏名欄１(T12)
=IF(AND(D12<>"",OR(T11="〃",T11="長谷川")),"〃",IF(AND(D12<>"",T11=""),"長谷川",""))

　氏名欄２(AN12)
=IF(AND(Z12<>"",OR(AN11="〃",AN11="長谷川")),"〃",IF(AND(Z12<>"",AN11=""),"長谷川",""))

　氏名欄３(BJ12)
=IF(AND(AT12<>"",OR(BJ11="〃",BJ11="長谷川")),"〃",IF(AND(AT12<>"",BJ11=""),
"長谷川",""))

　また上記関数の場合、時間帯が切り替わる時には正しい"氏名（苗字のみ）"が入力されない
　ので、その場合の各氏名欄へは手入力が必要となっています。

　★時刻欄２（W列）、時刻欄３（AQ列）について

　　基本的に内容欄１（D列）の入力を基準として、関連する項目があれば、内容欄２（Z列）もしくは
　　内容欄３（AT列）に追加入力があります。
　　その場合、入力時刻は内容欄１（D列）の時刻と同じにします。

　　となるように、時刻欄２（W列）と時刻欄３（AQ列）で、下記関数を使用中です。

　◎例えば：時刻欄１（A12）と内容欄１（D12）に入力や記述があり、内容欄２（Z12）または
　　 内容欄３（AT12）にも記述がある場合には、時刻欄２（W12）や時刻欄３（AQ12)に時刻が
　　 自動入力されるとして

　　時刻欄２（W12）： =IF(Z12="","",A12)

　　時刻欄３（AQ12）：　=IF(AT12="","",A12)

　　なお、内容欄１（D列）、内容欄２（Z列）、内容欄３（AT列）への記述は、１～数行になることが
　　あります。
　　この場合、該当する時刻欄には最初の行のみ時刻を入力し、以下の行の時刻欄は空白と
　　なります。

　★内容欄１（D列）、内容欄２（Z列）、内容欄３（AT列）について

　　 内容欄１（D列）への記述で（　）付の文字列、　○号室 or △号室 or □号室 or 空き
　　 のみの場合には、自動で中央揃えになるように下記のVBAを使用中しています。
　　 これが唯一、重宝している置きみやげでした。

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Sh.Range("D:D"), Target) Is Nothing Then Exit Sub

Dim r As Range
For Each r In Intersect(Sh.Range("D:D"), Target)
If InStr("/（○号室）/（△号室）/（□号室）/（空き）/", "/" & r.Value & "/") > 0 Then
r.HorizontalAlignment = xlCenter
End If
Next
End Sub

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
　上記、内容欄１（D列）で処理されるVBAを除いて、関数や条件付書式などを考えて改良を
　試みてみましたが、難しかったです。 上の内容欄１（D列）のVBAを含めたものなら幸いです。
　よろしくお願いいたします。

回答No.1

TAKA_R

勘違いして別のもの作ってました・・・。
下ので、それらしく行くはずではないかと思います。
日報の表の書き始めは、９行目からになっています。
基本的にＡ列の時刻は時刻欄２・３へ自動的に書き込まれます。
時刻欄２・３は、自動的に担当者名を書き込みます。
注意：Ａ列を書き込んだ後から、時刻欄２・３を書き直した場合、Ａ列が優先されません。
Ａ列をダブルクリックするなり、再確定して下さい。
書かれていたＶＢＡに、Ｚ列とＡＴ列も加えました。

Option Explicit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
Dim cl
Union(sh.Range("w:w"), sh.Range("aq:aq")).NumberFormatLocal = "h:mm"
If target.Column = Range("a:a").Column Then
If Range("z" & target.Row) <> "" Then Range("w" & target.Row) = Range("a" & target.Row)
If Range("at" & target.Row) <> "" Then Range("aq" & target.Row) = Range("a" & target.Row)
End If
If target.Row > 8 Then
Select Case target.Column
Case Range("a:a").Column
cl = Array("t", "a", "d")
Case Range("w:w").Column
cl = Array("an", "w", "z")
Case Range("aq:aq").Column
cl = Array("bj", "aq", "at")
End Select
Select Case target.Column
Case Range("a:a").Column, Range("w:w").Column, Range("aq:aq").Column
Call kaki(target, cl, sh)
End Select
End If

Dim r As Range
If Intersect(Union(sh.Range("D:D"), sh.Range("z:z"), sh.Range("at:at")), target) Is Nothing Then Exit Sub
For Each r In Intersect(Union(sh.Range("D:D"), sh.Range("z:z"), sh.Range("at:at")), target)
If InStr("/（○号室）/（△号室）/（□号室）/（空き）/", "/" & r.Value & "/") > 0 Then
r.HorizontalAlignment = xlCenter
End If
Next
End Sub

Sub kaki(target As Range, cl, sh As Object)
Dim h1, h2
Dim c As Long
h1 = Array("8:30", "12:00", "17:15", "20:30")
h2 = Array(sh.Range("t4").Value, sh.Range("ac4").Value, sh.Range("al4").Value, sh.Range("au4").Value, sh.Range("bd4").Value)
Select Case target.Value
Case ""
sh.Range(cl(0) & target.Row).Value = ""
Case Is < TimeValue(h1(0))
sh.Range(cl(0) & target.Row).Value = Left(h2(0), InStr(h2(0), "　") - 1)
Case Is < TimeValue(h1(1))
sh.Range(cl(0) & target.Row).Value = Left(h2(1), InStr(h2(1), "　") - 1)
Case Is < TimeValue(h1(2))
sh.Range(cl(0) & target.Row).Value = Left(h2(2), InStr(h2(2), "　") - 1)
Case Is < TimeValue(h1(3))
sh.Range(cl(0) & target.Row).Value = Left(h2(3), InStr(h2(3), "　") - 1)
Case Else
sh.Range(cl(0) & target.Row).Value = Left(h2(4), InStr(h2(4), "　") - 1)
End Select
Do
c = c + 1
If sh.Range(cl(1) & target.Row + c).Value = "" And sh.Range(cl(2) & target.Row + c).Value <> "" Then sh.Range(cl(0) & target.Row + c).Value = "〃"
Loop Until sh.Range(cl(1) & target.Row + c).Value <> "" Or sh.Range(cl(2) & target.Row + c).Value = ""
End Sub

お礼

ご回答いただきありがとう御座いました。早速使わせていただき、ほぼ希望通りの処理が出来ました。一部で手直しが必要な箇所もありましたが、TAKA_R　さんのご回答を参考にさせて頂き、VBAの勉強を兼ねて修正に挑戦してみたいと思います。