He visto que la primera solución propuesta no contempla las palabras que empiezan por mayúsculas o la palabra I y hace el reemplazo por el carácter _.
Así que he encontrado una solución que sí que funciona bien en todos los casos que he probado, considerando que las palabras pueden estar separadas por espacios, comas, puntos o punto y coma:
Function ReemplazaMayusculasPorSubrayado(strToConvert) As String
Dim i As Integer
Dim j As Integer
Dim strDST As String
Dim isCaps As Boolean
strToConvert = Replace(strToConvert, ".", " .")
strToConvert = Replace(strToConvert, ",", " ,")
strToConvert = Replace(strToConvert, ";", " ;")
strToConvert = strToConvert + " "
i = 1
strDST = ""
While i < Len(strToConvert)
j = i
isCaps = True
While Mid(strToConvert, j, 1) <> " " And j < Len(strToConvert)
If Mid(strToConvert, j, 1) = LCase(Mid(strToConvert, j, 1)) Then
isCaps = False
End If
j = j + 1
Wend
If isCaps And (Mid(strToConvert, j, 1) = " " Or j = Len(strToConvert)) And j - i > 1 Then
If Mid(strToConvert, j, 1) = " " Then
strDST = strDST + String(j - i, "_") + " "
Else
strDST = strDST + String(j - i + 1, "_")
End If
Else
strDST = strDST + Mid(strToConvert, i, j - i + 1)
End If
i = j + 1
Wend
strDST = Replace(strDST, " .", ".")
strDST = Replace(strDST, " ,", ",")
strDST = Replace(strDST, " ;", ";")
strDST = Mid(strDST, 1, Len(strDST) - 1)
ReemplazaMayusculasPorSubrayado= strDST
End Function
Esta función habría que llamarla para todas las celdas de tu Base de Datos en Excel y habría que guardar el resultado en la celda contigua.
Te pongo un ejemplo de como se podría llamar pero tendrías que parametrizar la función para inicializar las variables intFila e intColumna con los valores donde empieza tu rango y dejar la columna de al lado vacía porque la macro te la rellenará:
Public Sub ReemplazaTodo()
Dim intFila As Integer
Dim intColumna As Integer
intFila = 1
intColumna = 1
While Len(Cells(intFila, intColumna).Value) > 0
Cells(intFila, intColumna + 1).Value = ReemplazaMayusculasPorSubrayado(Cells(intFila, intColumna).Value)
intFila = intFila + 1
DoEvents
Wend
End Sub