Ваш вопрос не ясен, но это должно помочь вам
Sub AvoidThePirates()
Dim startRow As Integer
startRow = 2 ' EDIT THIS ME HEARTIES
Dim columnToLookUp As String
columnToLookUp = "C" ' Arrrgh ye scurvy sea dog
Dim columnResults As String
columnResults = "D" ' Show me ya gold
'Touch below this and I'll feed ya to the sharks
Dim isUpper As Boolean
Do While (Range(columnToLookUp & startRow).Value <> "")
Dim hasUpper As Boolean
hasUpper = False
isUpper = False
Dim valueToCheck As String
valueToCheck = Range(columnToLookUp & startRow).Value
valueToCheck = Replace(valueToCheck, ".", "")
Dim i As Integer
For i = 0 To Len(valueToCheck)
Dim chara As String
chara = Mid(valueToCheck, i + 1, 1)
If IsLetter(chara) Then
If StrComp(chara, UCase(chara), vbBinaryCompare) = 0 Then
Dim charaB As String
charaB = Mid(valueToCheck, i + 2, 1)
If IsLetter(charaB) Then
If StrComp(charaB, UCase(charaB), vbBinaryCompare) = 0 Then
isUpper = True
Exit For
End If
End If
End If
End If
Next i
If (isUpper) Then
Range(columnResults & startRow).Value = "UPPER"
Else
Range(columnResults & startRow).Value = "lower"
End If
startRow = startRow + 1
Loop
End Sub
Function IsLetter(strValue As String) As Boolean
Dim intPos As Integer
For intPos = 1 To Len(strValue)
Select Case Asc(Mid(strValue, intPos, 1))
Case 65 To 90, 97 To 122
IsLetter = True
Case Else
IsLetter = False
Exit For
End Select
Next
End Function
До
После запуска VBa
Также см. Как добавить VBA в MS Office?