Доброе время суток Форумчане. Надо что бы в введённые в ячейке фамилии с инициалами (иногда просто фамилия) писались с Заглавной буквы. Нашёл в Internet`e макрос: [vba]
Код
Sub Proper_Case() For Each x In Range("C1:C5") x.Value = Application.Proper(x.Value) Next End Sub
[/vba] но он работает по нажатию на кнопку. Помогите сделать так, что бы данные в ячейке изменялись автоматически при после заполнении ячейки.
Доброе время суток Форумчане. Надо что бы в введённые в ячейке фамилии с инициалами (иногда просто фамилия) писались с Заглавной буквы. Нашёл в Internet`e макрос: [vba]
Код
Sub Proper_Case() For Each x In Range("C1:C5") x.Value = Application.Proper(x.Value) Next End Sub
[/vba] но он работает по нажатию на кнопку. Помогите сделать так, что бы данные в ячейке изменялись автоматически при после заполнении ячейки.DrMini
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False For Each x In Target x.Value = Application.Proper(x.Value) Next x Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False For Each x In Target x.Value = Application.Proper(x.Value) Next x Application.EnableEvents = True End Sub
У меня что-то получилось но... не совсем. Очень долго обрабатывается (2-3 секунды голубой ореол вокруг курсора) после ввода данных в любую ячейку. Как будто, что-то зациклилось. Подправьте пожалуйста. Файл прилагаю.
У меня что-то получилось но... не совсем. Очень долго обрабатывается (2-3 секунды голубой ореол вокруг курсора) после ввода данных в любую ячейку. Как будто, что-то зациклилось. Подправьте пожалуйста. Файл прилагаю.DrMini
просто вы все ячейки диапазона прогоняете через функцию, добавил условие если не пустая а еще несколько раз в процедуре включать и отключать обработку событий и обновление экрана не обоснованная трата ресурсов вначале отключаете, выполняете код потом включаете
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Application.ScreenUpdating = 0 If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C5:C10000,E5:E10000,G5:G10000")) Is Nothing Then If Target.NumberFormat = "m/d/yyyy" Then Target.NumberFormat = "General" End If x_ = Target If Len(x_) = 5 Or Len(x_) = 6 Then If IsDate(Format(x_, "00\/00\/00")) Then If Mid(Format(x_, "00\/00\/00"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/00")) Else: GoTo error_ End If ElseIf Len(x_) = 7 Or Len(x_) = 8 Then If IsDate(Format(x_, "00\/00\/0000")) Then If Mid(Format(x_, "00\/00\/0000"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/0000")) Else: GoTo error_ End If Else: GoTo error_ End If
Target = x_
ElseIf Not Intersect(Target, Range("D5:D10000,F5:F10000,H5:H10000")) Is Nothing Then If Len(Target) = 3 Or Len(Target) = 4 Then If IsDate(Format(Format(Target.Value, "00:00"), "h:nn")) Then Target = Format(Format(Target.Value, "00:00"), "h:nn") Else Application.Undo End If End If End If Dim d0_ As Range Set d_ = Intersect(Target, Range("J5:J2000")) If Not d_ Is Nothing Then
On Error Resume Next With d_ For Each d0_ In d_ d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Next d0_ End With
End If ' Прописные
'For Each x In Target 'на весь лист For Each x In Range("I5:I2000") 'диапазон If x.Value <> "" Then x.Value = Application.Proper(x.Value) Next x Application.EnableEvents = True Application.ScreenUpdating = 1 Exit Sub error_: Target = Empty Application.EnableEvents = True End Sub
[/vba]
не то что зациклилось
просто вы все ячейки диапазона прогоняете через функцию, добавил условие если не пустая а еще несколько раз в процедуре включать и отключать обработку событий и обновление экрана не обоснованная трата ресурсов вначале отключаете, выполняете код потом включаете
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Application.ScreenUpdating = 0 If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C5:C10000,E5:E10000,G5:G10000")) Is Nothing Then If Target.NumberFormat = "m/d/yyyy" Then Target.NumberFormat = "General" End If x_ = Target If Len(x_) = 5 Or Len(x_) = 6 Then If IsDate(Format(x_, "00\/00\/00")) Then If Mid(Format(x_, "00\/00\/00"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/00")) Else: GoTo error_ End If ElseIf Len(x_) = 7 Or Len(x_) = 8 Then If IsDate(Format(x_, "00\/00\/0000")) Then If Mid(Format(x_, "00\/00\/0000"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/0000")) Else: GoTo error_ End If Else: GoTo error_ End If
Target = x_
ElseIf Not Intersect(Target, Range("D5:D10000,F5:F10000,H5:H10000")) Is Nothing Then If Len(Target) = 3 Or Len(Target) = 4 Then If IsDate(Format(Format(Target.Value, "00:00"), "h:nn")) Then Target = Format(Format(Target.Value, "00:00"), "h:nn") Else Application.Undo End If End If End If Dim d0_ As Range Set d_ = Intersect(Target, Range("J5:J2000")) If Not d_ Is Nothing Then
On Error Resume Next With d_ For Each d0_ In d_ d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Next d0_ End With
End If ' Прописные
'For Each x In Target 'на весь лист For Each x In Range("I5:I2000") 'диапазон If x.Value <> "" Then x.Value = Application.Proper(x.Value) Next x Application.EnableEvents = True Application.ScreenUpdating = 1 Exit Sub error_: Target = Empty Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C5:C10000,E5:E10000,G5:G10000")) Is Nothing Then If Target.NumberFormat = "m/d/yyyy" Then Target.NumberFormat = "General" End If x_ = Target If Len(x_) = 5 Or Len(x_) = 6 Then If IsDate(Format(x_, "00\/00\/00")) Then If Mid(Format(x_, "00\/00\/00"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/00")) Else: GoTo error_ End If ElseIf Len(x_) = 7 Or Len(x_) = 8 Then If IsDate(Format(x_, "00\/00\/0000")) Then If Mid(Format(x_, "00\/00\/0000"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/0000")) Else: GoTo error_ End If Else: GoTo error_ End If Application.EnableEvents = False Target = x_ Application.EnableEvents = True ElseIf Not Intersect(Target, Range("D5:D10000,F5:F10000,H5:H10000")) Is Nothing Then If Len(Target) = 3 Or Len(Target) = 4 Then If IsDate(Format(Format(Target.Value, "00:00"), "h:nn")) Then Application.EnableEvents = False Target = Format(Format(Target.Value, "00:00"), "h:nn") Application.EnableEvents = True Else Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End If ElseIf Not Intersect(Target, Range("J5:J10000")) Is Nothing Then Application.EnableEvents = False If Len(Target) Then Target = --Right(Target, 10) Target.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Application.EnableEvents = True ElseIf Not Intersect(Target, Range("I5:I10000")) Is Nothing Then Application.EnableEvents = False Target = Application.Proper(Target) Application.EnableEvents = True End If
Exit Sub error_: Application.EnableEvents = False Target = Empty Application.EnableEvents = True End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C5:C10000,E5:E10000,G5:G10000")) Is Nothing Then If Target.NumberFormat = "m/d/yyyy" Then Target.NumberFormat = "General" End If x_ = Target If Len(x_) = 5 Or Len(x_) = 6 Then If IsDate(Format(x_, "00\/00\/00")) Then If Mid(Format(x_, "00\/00\/00"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/00")) Else: GoTo error_ End If ElseIf Len(x_) = 7 Or Len(x_) = 8 Then If IsDate(Format(x_, "00\/00\/0000")) Then If Mid(Format(x_, "00\/00\/0000"), 4, 2) > 12 Then GoTo error_ x_ = CDate(Format(x_, "00\/00\/0000")) Else: GoTo error_ End If Else: GoTo error_ End If Application.EnableEvents = False Target = x_ Application.EnableEvents = True ElseIf Not Intersect(Target, Range("D5:D10000,F5:F10000,H5:H10000")) Is Nothing Then If Len(Target) = 3 Or Len(Target) = 4 Then If IsDate(Format(Format(Target.Value, "00:00"), "h:nn")) Then Application.EnableEvents = False Target = Format(Format(Target.Value, "00:00"), "h:nn") Application.EnableEvents = True Else Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End If ElseIf Not Intersect(Target, Range("J5:J10000")) Is Nothing Then Application.EnableEvents = False If Len(Target) Then Target = --Right(Target, 10) Target.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Application.EnableEvents = True ElseIf Not Intersect(Target, Range("I5:I10000")) Is Nothing Then Application.EnableEvents = False Target = Application.Proper(Target) Application.EnableEvents = True End If
Exit Sub error_: Application.EnableEvents = False Target = Empty Application.EnableEvents = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
