Совсем обленились...

Всем доброй ночи!  
Чтоб не забивать форум схожими темами решил написать в старой.  
Тем более, что вопрос похожий, только условия чуть изменились.  
Изначально требовалось вводить в ячейку фамилию и инициалы (ИВАНОВ И.И.). Вопрос автоматического изменения регистра на прописной решался с помощью такого макроса:  
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim inRange As Range    ' проверяемый диапазон  
   Dim r As Range  
   On Error Resume Next  
   Set inRange = Range("Таблица1[Фамилия, инициалы]")
   If Not Intersect(Target, inRange) Is Nothing Then  
       Application.EnableEvents = False  
       For Each r In Intersect(Target, inRange)  
           If Not IsEmpty® Then  
               r.Value = UCase(r.Value)  
           End If  
       Next r  
       Application.EnableEvents = True  
   End If  
...  
(Дальше идет продолжение кода к регистру не имеющее отношения)  
Сегодня требования изменились и теперь нужно имя и отчество забивать полностью в виде: ИВАНОВ Иван Иванович (фамилия - все буквы прописные, имя и отчество - только первые). Поиск по форуму результата не дал, хотя вроде и видел где-то что-то похожее.  
Прошу помочь с изменением указанного макроса.  
(может как-то можно использовать для фамилии параметр vbUpperCase, а для имени и отчества vbProperCase функции StrConv?)  
Спасибо.

Спасибо, Юрий, то, что нужно.  
Сразу не продумал, что надо было оставить возможность ввода и сокращенного варианта (инициалы), и полного, попытался сам внести изменения в код макроса с использованием Вашего решения и проверки текста по маске, но что-то не получается.  
В итоге получилост 3 варианта, из которых только последний работает на половину.    
1 вариант:  
For Each r In Intersect(Target, inRange)  
       If Not IsEmpty® Then  
           Select Case r.Value  
           Case Is = r.Value Like "* [А-Я].[А-Я]."
               r.Value = UCase(r.Value)  
           Case Is = r.Value Like "* * *"  
               r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2)))  
           End Select  
       End If  
   Next r  
 
2 вариант:  
For Each r In Intersect(Target, inRange)  
       If Not IsEmpty® Then  
       If r = r.Value Like "* [À-ß].[À-ß]." Then
       r.Value = UCase(r.Value)  
       If r = r.Value Like "* * *" Then  
       r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2)))  
       End If  
       End If  
       End If  
   Next r  
 
3 вариант:  
For Each r In Intersect(Target, inRange)  
       If Not IsEmpty® Then  
       If r = r.Value Like "* [А-Я].[А-Я]." Then
       r.Value = UCase(r.Value)  
       Else: r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2)))  
       End If  
       End If  
   Next r  
 
Очень хотелось бы понять, что делаю не так.

Может быть так:  
3 вариант:  
For Each r In Intersect(Target, inRange)  
If Not IsEmpty® Then  
If r.Value Like "* [А-ЯЁ].[А-ЯЁ]." Then
r.Value = UCase(r.Value)  
Else: r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2)))  
End If  
End If  
Next    
 
(Ё добавил на всякий случай, мало ли какие теперь отчества бывают :) )

Еще не могу понять синтаксис Split®(0),  
r - обязательный аргумент Expression, это ясно, а вот (0) что?  
Есть предположение, что относится к UCase, но хотелось бы по-точнее его роль понять.

Опытным путем уже допер до этого, но не знал как правильно назвать. Юрий, Вы не  мастер, Вы - UCase(мастер) )))  
 
Теперь не могу понять почему маски "* * *" и "* * * *" конфликтуют между собой (интуитивно догадываюсь почему), ведь в одной из них три последовательности символов через пробелы, а в другой - четыре? Но, видимо, он применяет маску "* * *" первой...

Скорее всего, пока остановлюсь на таком варианте:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim inRange As Range  
Dim r As Range  
On Error Resume Next  
Set inRange = Range("A1:A10") 'диапазон действия макроса  
   If Not Intersect(Target, inRange) Is Nothing Then  
   Application.EnableEvents = False  
   For Each r In Intersect(Target, inRange)  
       If Not IsEmpty® Then  
       If r.Value Like "* * * *" Then 'проверяется соответствие значения переменной r маске "* * * *"  
       r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2))) & " " & Application.Proper((Split®(3))) 'иванов иван иванович оглы преобразует в ИВАНОВ Иван Иванович Оглы  
       ElseIf r.Value Like "* * *" Then  
       r.Value = UCase(Split®(0)) & " " & Application.Proper((Split®(1))) & " " & Application.Proper((Split®(2))) 'иванов иван иванович преобразует в ИВАНОВ Иван Иванович  
       ElseIf r.Value Like "*-* * *" Then  
       r.Value = UCase(Split®(0)) & "-" & Application.Upper((Split®(1))) & " " & Application.Proper((Split®(2))) & " " & Application.Proper((Split®(3))) 'преобразует кара-мурза сергей георгиевич в КАРА-МУРЗА Сергей Георгиевич  
       Else: r.Value = UCase(r.Value)  
       End If  
       End If  
   Next r  
Application.EnableEvents = True  
End If  
End Sub

Прошу прощения, но возник еще один вопрос:  
выражение StrConv(r.Value, vbProperCase) делает прописной первую букву каждого слова, при этом разделителем между словами служит пробел.  
А хотелось бы, чтобы кроме пробела в качестве разделителя можно было использовать знак "-" (дефис или, как я понял, знак перевода строки?)  
В описании функции StrConv на: http://office.microsoft.com/ru-ru/access-help/HA001228915.aspx говорится, что в качестве разделителя слов можно использовать несколько символов.  
Вопрос - какой вид должна иметь формула с учетом разделителя?  
Такая не работает:  
StrConv(r.Value, vbProperCase, Chr$(10) + Chr$(32)),  
ВБА выдает ошибку(((  
Спасибо.

Понял, что делаю не правильно - не хватало аргумента разделитель в функции Split:  
для того чтобы текст "равшан-оглы" преобразовывался в "Равшан-Оглы" нужно было указать в качестве разделителя "-", что и сделал. В итоге получилось как-то так:  
If r.Value Like ("*-*") Then  
r.Value = Application.Proper((Split(r, "-")(0))) & "-" & Application.Proper((Split(r, "-")(1)))  
Else: r.Value = StrConv(r.Value, vbProperCase)  
End If  
 
Вообщем, вопрос предыдущего сообщения можно считать решенным.

Вариант на регулярных выражениях    
Private FFinder As Object  
 
Private Sub InitFinder()  
   Set FFinder = CreateObject("VBScript.RegExp")  
   FFinder.Global = True: FFinder.Pattern = "(^| |-|\n|\t)[а-яё]"
End Sub  
 
Private Function GetFirstUpper(ByVal sText As String) As String  
   Dim Entries As Object, subChar As Object  
   Set Entries = FFinder.Execute(sText)  
   For Each subChar In Entries  
       If subChar.Length = 1 Then  
           Mid$(sText, subChar.FirstIndex + 1, 1) = UCase$(subChar.Value)  
       Else  
           Mid$(sText, subChar.FirstIndex + 2, 1) = UCase$(Mid$(subChar.Value, 2, 1))  
       End If  
   Next  
   GetFirstUpper = sText  
End Function  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim MyRange As Range, pCell As Range  
     
   Set MyRange = Application.Intersect(Target, Columns("B:D"), UsedRange)  
   If Not MyRange Is Nothing Then  
       Application.EnableEvents = False  
       If FFinder Is Nothing Then InitFinder  
       For Each pCell In MyRange  
           If pCell.Column = 2 Then  
               pCell.Value = UCase$(pCell.Value)  
           Else  
               pCell.Value = GetFirstUpper(pCell.Value)  
           End If  
       Next  
       Application.EnableEvents = True  
   End If  
End Sub

Прошу уважаемых модераторов не судить строго за то, что разные, на первый взгляд, вопросы размещаю в одной теме. Однако все они применяются для одного и того же  - написания ФИО (хоть и в различных вариантах).  
 
Вот хочу еще один вариант вынести на Ваш суд, на этот раз сделанный через формулы.  
Вопрос в следующем: итоговая мегаформула (столбец ФИО) достаточно массивна, и, при этом, рассматривает только составные имена и отчества, состоящие из двух частей.  
Вообщем-то она устраивает.  
Но, может быть кто-то из спецов по формулам подскажет более красивый и универсальный вариант?  
Буду Вам очень признателен.  
 
Чуть не забыл, в формуле используется функция Substring    
(http://www.planetaexcel.ru/tip.php?aid=54)