Добрый вечер. Помогите пожалуйста с макросом. Необходимо ...при вводе текста, после нажатия ENTR... чтоб добавлялся введенный текст в соседнюю ячейку, а в ячейке ввода очищался, в итого проставлялось количество введенных.. С возможностью в макросе указать (прокомментировать), для подстройки макроса для других столбцов(откуда берется, куда вставляется, где подсчитывается)
Добрый вечер. Помогите пожалуйста с макросом. Необходимо ...при вводе текста, после нажатия ENTR... чтоб добавлялся введенный текст в соседнюю ячейку, а в ячейке ввода очищался, в итого проставлялось количество введенных.. С возможностью в макросе указать (прокомментировать), для подстройки макроса для других столбцов(откуда берется, куда вставляется, где подсчитывается)cmivadwot
NikitaDvorets, день добрый. Как должно получаться..поэтапно, разделением синей чертой в файле-примере. в одной ячейке всегда вводим текст, например ФИО, при нажатии Entr этот текст записывается в соседнюю ячейку и так каждый раз при вводе, а в соседней добавляется номер и разделитель точка с запятой, далее ячейка ввода очищается.
NikitaDvorets, день добрый. Как должно получаться..поэтапно, разделением синей чертой в файле-примере. в одной ячейке всегда вводим текст, например ФИО, при нажатии Entr этот текст записывается в соседнюю ячейку и так каждый раз при вводе, а в соседней добавляется номер и разделитель точка с запятой, далее ячейка ввода очищается.cmivadwot
Сообщение отредактировал cmivadwot - Пятница, 18.10.2024, 13:34
cmivadwot, Доброго времени суток. Тоже как-то решали похожий вопрос про "Просмотр изминений в excel" на соседнем форуме (Ноги начали расти от туда). Потом и сам как-то задался этим вопросом (заинтересовало меня эта тема). Было просмотрено много тем с этой тематикой и для себя начал ещё тода ставить эксперименты. В дальнейшем я всё-же внедрил в один из своих проэктов полученый опыт. Ваш случай меня тоже заинтересовал и стал заново разбираться. Путём (опять же) экспериментов (у меня нет должного образования, самоучка) вроде получилось решить ваш вопрос, возможно.
[vba]
Код
Option Explicit ' Обязательное явное объявление всех переменных
Private Sub Worksheet_Change(ByVal Target As Range) ' Обработчик события изменения на листе Dim i As Long ' Объявляем переменную для цикла Dim CurrentIndex As Long ' Объявляем переменную для хранения текущего индекса
If Not Intersect(Target, Me.Range("H5")) Is Nothing Then ' Проверяем, изменена ли ячейка H5 Application.EnableEvents = False ' Отключаем события, чтобы избежать повторного вызова этого события
Dim NewValue As String ' Объявляем переменную для хранения нового значения NewValue = Target.Value ' Сохраняем новое значение из измененной ячейки
Application.Undo ' Отменяем последнее изменение, чтобы получить предыдущее значение
Dim CurrentValues As String ' Объявляем переменную для хранения текущих значений в I5 CurrentValues = Target.Offset(, 1).Value ' Получаем текущее значение из I5
' Форматируем новое значение Dim NameParts() As String ' Объявляем массив строк для частей имени NameParts = Split(NewValue, " ") ' Разделяем новое значение по пробелам
If UBound(NameParts) >= 1 Then ' Проверяем, есть ли хотя бы имя и фамилия
' Рассчитываем следующий индекс Dim Values As Variant ' Объявляем массив для текущих значений Values = Split(CurrentValues, "; ") ' Разделяем текущие значения по "; "
For i = LBound(Values) To UBound(Values) ' Цикл по всем текущим значениям
If InStr(1, Values(i), ")") > 0 Then ' Проверяем, содержит ли значение символ ")" CurrentIndex = Application.Max(CurrentIndex, Val(Left(Values(i), InStr(1, Values(i), ")") - 1))) ' Обновляем CurrentIndex, если найдено большее значение End If
Next i ' Переходим к следующему значению
' Включаем инициалы для имени и фамилии Dim FormattedNewValue As String ' Объявляем переменную для хранения отформатированного нового значения FormattedNewValue = (CurrentIndex + 1) & ") " & NameParts(0) & " " & Left(NameParts(1), 3) & "." ' Форматируем новое значение, включая инициалы
If UBound(NameParts) >= 2 Then ' Проверяем, есть ли второе имя FormattedNewValue = FormattedNewValue & Left(NameParts(2), 1) & "." ' Добавляем первую букву второго имени End If
Else FormattedNewValue = NewValue ' Если формат неправильный, просто возвращаем новое значение End If
' Обновляем I5 с новым отформатированным значением If CurrentValues <> "" And InStr(1, CurrentValues, FormattedNewValue) = 0 Then ' Если текущее значение не пустое и не содержит новое значение Target.Offset(, 1).Value = CurrentValues & "; " & FormattedNewValue ' Добавляем отформатированное новое значение в текущие значения Target.Offset(, 2).Value = CurrentIndex + 1 ' Обновляем индекс в J5
ElseIf CurrentValues = "" Then ' Если текущее значение пустое Target.Offset(, 1).Value = FormattedNewValue ' Устанавливаем отформатированное новое значение в I5 Target.Offset(, 2).Value = CurrentIndex + 1 ' Обновляем индекс в J5 End If
Target.Value = "" ' Очищаем значение измененной ячейки Application.EnableEvents = True ' Включаем события обратно End If
End Sub
[/vba]
Ответ за вами, удалось мне вам помочь. За коментарии в коде просьба не пинать сильно, как смог так и описал. Удачи.
P.S. Для вашего файла примера код сработает только для ячейки H5. Далее сами сможете докрутить для остальных ячеек.
cmivadwot, Доброго времени суток. Тоже как-то решали похожий вопрос про "Просмотр изминений в excel" на соседнем форуме (Ноги начали расти от туда). Потом и сам как-то задался этим вопросом (заинтересовало меня эта тема). Было просмотрено много тем с этой тематикой и для себя начал ещё тода ставить эксперименты. В дальнейшем я всё-же внедрил в один из своих проэктов полученый опыт. Ваш случай меня тоже заинтересовал и стал заново разбираться. Путём (опять же) экспериментов (у меня нет должного образования, самоучка) вроде получилось решить ваш вопрос, возможно.
[vba]
Код
Option Explicit ' Обязательное явное объявление всех переменных
Private Sub Worksheet_Change(ByVal Target As Range) ' Обработчик события изменения на листе Dim i As Long ' Объявляем переменную для цикла Dim CurrentIndex As Long ' Объявляем переменную для хранения текущего индекса
If Not Intersect(Target, Me.Range("H5")) Is Nothing Then ' Проверяем, изменена ли ячейка H5 Application.EnableEvents = False ' Отключаем события, чтобы избежать повторного вызова этого события
Dim NewValue As String ' Объявляем переменную для хранения нового значения NewValue = Target.Value ' Сохраняем новое значение из измененной ячейки
Application.Undo ' Отменяем последнее изменение, чтобы получить предыдущее значение
Dim CurrentValues As String ' Объявляем переменную для хранения текущих значений в I5 CurrentValues = Target.Offset(, 1).Value ' Получаем текущее значение из I5
' Форматируем новое значение Dim NameParts() As String ' Объявляем массив строк для частей имени NameParts = Split(NewValue, " ") ' Разделяем новое значение по пробелам
If UBound(NameParts) >= 1 Then ' Проверяем, есть ли хотя бы имя и фамилия
' Рассчитываем следующий индекс Dim Values As Variant ' Объявляем массив для текущих значений Values = Split(CurrentValues, "; ") ' Разделяем текущие значения по "; "
For i = LBound(Values) To UBound(Values) ' Цикл по всем текущим значениям
If InStr(1, Values(i), ")") > 0 Then ' Проверяем, содержит ли значение символ ")" CurrentIndex = Application.Max(CurrentIndex, Val(Left(Values(i), InStr(1, Values(i), ")") - 1))) ' Обновляем CurrentIndex, если найдено большее значение End If
Next i ' Переходим к следующему значению
' Включаем инициалы для имени и фамилии Dim FormattedNewValue As String ' Объявляем переменную для хранения отформатированного нового значения FormattedNewValue = (CurrentIndex + 1) & ") " & NameParts(0) & " " & Left(NameParts(1), 3) & "." ' Форматируем новое значение, включая инициалы
If UBound(NameParts) >= 2 Then ' Проверяем, есть ли второе имя FormattedNewValue = FormattedNewValue & Left(NameParts(2), 1) & "." ' Добавляем первую букву второго имени End If
Else FormattedNewValue = NewValue ' Если формат неправильный, просто возвращаем новое значение End If
' Обновляем I5 с новым отформатированным значением If CurrentValues <> "" And InStr(1, CurrentValues, FormattedNewValue) = 0 Then ' Если текущее значение не пустое и не содержит новое значение Target.Offset(, 1).Value = CurrentValues & "; " & FormattedNewValue ' Добавляем отформатированное новое значение в текущие значения Target.Offset(, 2).Value = CurrentIndex + 1 ' Обновляем индекс в J5
ElseIf CurrentValues = "" Then ' Если текущее значение пустое Target.Offset(, 1).Value = FormattedNewValue ' Устанавливаем отформатированное новое значение в I5 Target.Offset(, 2).Value = CurrentIndex + 1 ' Обновляем индекс в J5 End If
Target.Value = "" ' Очищаем значение измененной ячейки Application.EnableEvents = True ' Включаем события обратно End If
End Sub
[/vba]
Ответ за вами, удалось мне вам помочь. За коментарии в коде просьба не пинать сильно, как смог так и описал. Удачи.
P.S. Для вашего файла примера код сработает только для ячейки H5. Далее сами сможете докрутить для остальных ячеек.MikeVol
Ученик. Одесса - Украина
Сообщение отредактировал MikeVol - Пятница, 18.10.2024, 13:42
MikeVol, поковырял, работает но без номеров и как зациклить на весь столбец даже мыслей нет.. куда копать. Для меня не принципиально как...Вот с доп столбцом и вручную клацать запуск макроса получилось, но опять же как распространить на другие строки и по событию в ячейке ввода... и этого б было достаточно. Пока не прижало и нет времени вникнуть)))) Может кто еще откликнется...
MikeVol, поковырял, работает но без номеров и как зациклить на весь столбец даже мыслей нет.. куда копать. Для меня не принципиально как...Вот с доп столбцом и вручную клацать запуск макроса получилось, но опять же как распространить на другие строки и по событию в ячейке ввода... и этого б было достаточно. Пока не прижало и нет времени вникнуть)))) Может кто еще откликнется...cmivadwot
В файле-примере и описании не было указано на количество фамилий, а в в пятницу ночью мне в голову не пришло, что их число может быть двузначным ... Хотя может вы уже и сами допилили ...
В файле-примере и описании не было указано на количество фамилий, а в в пятницу ночью мне в голову не пришло, что их число может быть двузначным ... Хотя может вы уже и сами допилили ...WowGun
Может пригодиться. Я ввел фамилию, тут же ее скопировал, далее щелкнул в сторону, навел на клетку ввода ctrl+v, далее нажал и держал F4. скопированная фио навставлялась пока ф 4 не отпустить.
Может пригодиться. Я ввел фамилию, тут же ее скопировал, далее щелкнул в сторону, навел на клетку ввода ctrl+v, далее нажал и держал F4. скопированная фио навставлялась пока ф 4 не отпустить.cmivadwot