Здравствуйте, пожалуйста помогите с таким делом, имеется макрос который сокращает фио с Иванов Иван Иванович, до Иванов И.И. пожалуйста помогите дополнить макрос следующими функциями: - чтоб он работал с определенным столбцом (например D) всех листов книги содержащим в названии дату например 01.01.2015, 02.01.2015 и т.д. и что б пропускал строки в которых уже сокращенное фио или нет отчества Вот макрос: Заранее благодарна за помощь.
Код
Sub fio()
For Each rcell In Selection.Cells
FullFIO = rcell.Value
fio = Split(Application.WorksheetFunction.Trim(FullFIO), " ")
If UBound(fio) <= 3 Then
ShortFIO = fio(0) & " " & Left(fio(1), 1) & "." & Left(fio(2), 1) & "."
rcell.Value = ShortFIO
End If
Next
End Sub
Извините, наверное я что то не правильно объяснила, мне необходимо что б он работал постоянно с листами в названии которых есть даты (т.к. в книге содержатся и другие листы), и еще он постоянно ругается на те строки в которых фио уже в сокращенном варианте, может кто знает как это устранить
В таком случае сделайте пример с хотя бы вымышленными данными. Этот пример должен хотя бы отдаленно повторять структуру искомого файла. Сейчас разбираться с чем-то - это все равно, что разговаривать со стеной.
Sub qq()
Dim ws As Worksheet, ra As Range, rCell As Range, arr() As String
For Each ws In ThisWorkbook.Worksheets 'цикл по листам
If Right(ws.Name, 4) = "2015" Then 'проверка названия листа
Set ra = Range(ws.Cells(6, 4), ws.Cells(ws.Cells(Rows.Count, 4).End(xlUp).Row, 4))
ra = Application.Trim(ra) 'удаление пробелов
For Each rCell In ra.Cells 'цикл по ячейкам
arr = Split(rCell)
If UBound(arr) = 2 Then
rCell = arr(0) & " " & Left(arr(1), 1) & "." & Left(arr(2), 1) & "."
End If
Next rCell
End If
Next ws
End Sub