­ã´£³¡ªL

Sub TEST()
Dim P$, F$, xD, A, Tm, ADR$, xB As Workbook, xS As Worksheet
Tm = Timer
P = ThisWorkbook.Path
Set xD = CreateObject("Scripting.Dictionary")
Do
  If F = "" Then F = Dir(P & "\*.xls") Else F = Dir()
  If F = "" Then Exit Do
  If F Like "539_¤­¦æ±Æ§Ç-??Á`Äý-(####-##-##).xls" Then xD(F) = ""
Loop
If xD.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
ADR = "BA3:BF12,BA15:BF24,BA27:BF36,BA39:BF48,BA51:BF60,BA63:BF72,BA75:BF84"
For Each A In xD.keys
    Set xB = Workbooks.Open(P & "\" & A)
    For Each xS In xB.Sheets
        xS.Range(ADR).Interior.ColorIndex = 15
    Next
    xB.Close 1
Next
MsgBox Timer - Tm
End Sub


==================================