Nic70y, все верно сотрудники виртуозно владеют функцией копировать/вставить. Причем источники разные, как я выше перечислил - ворд, пдф, аутлук и др. Даже 1с. Из за этого общая книга раздута адски, и при этом не только форматы кривые вставляются, так еще и ячейка блокируется. Я уже устал обьяснять что бы не в ячейку пастили а в строку формул. Бесполезно.
Может есть простой код типа - при попытке что либо вставить то PasteSpecial Paste:=xlPasteValues, игнорируя форматы и т.п.?
Nic70y, все верно сотрудники виртуозно владеют функцией копировать/вставить. Причем источники разные, как я выше перечислил - ворд, пдф, аутлук и др. Даже 1с. Из за этого общая книга раздута адски, и при этом не только форматы кривые вставляются, так еще и ячейка блокируется. Я уже устал обьяснять что бы не в ячейку пастили а в строку формул. Бесполезно.
Может есть простой код типа - при попытке что либо вставить то PasteSpecial Paste:=xlPasteValues, игнорируя форматы и т.п.?Литр
Сообщение отредактировал Литр - Четверг, 23.04.2026, 13:30
Литр, у нас на работе есть главный копипастер, по совместительству главный бухгалтер, попросила меня сделать копистилку попробуйте может и вам понравиться: выделяйте ячейку столба M
Литр, у нас на работе есть главный копипастер, по совместительству главный бухгалтер, попросила меня сделать копистилку попробуйте может и вам понравиться: выделяйте ячейку столба MNic70y
Nic70y, нельзя же так жестоко да еще и с главбухом
а Ваш вариант конечно крутой, хотя символ "пробел" пропускает И можно б облегчить труд главбуха, так что бы UserForm3 закрывалась не по кнопке "ЗАПИСАТЬ", а просто тыкнуть на другой столбец отличный от "М"
Nic70y, нельзя же так жестоко да еще и с главбухом
а Ваш вариант конечно крутой, хотя символ "пробел" пропускает И можно б облегчить труд главбуха, так что бы UserForm3 закрывалась не по кнопке "ЗАПИСАТЬ", а просто тыкнуть на другой столбец отличный от "М"Литр
Function u() With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard u = .GetText End With End Function
[/vba]ну и написал макрос (в модуле листа) [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value = "" Then aa = u If aa <> "" Then ab = Replace(aa, ",", ".") If IsNumeric(ab) = False And aa <> "" Then ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then For ad = 1 To ac ae = InStr(ab, ".") af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If End If Target = Val(Replace(ab, " ", "")) Application.CutCopyMode = False End If End If End Sub
[/vba]скопируйте какую нибудь фигню похожую на число, выделите ячейку в M
апдэйт есть косяки, но сегодня уже не исправлю
Литр, стырил я где-то UDF [vba]
Код
Function u() With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard u = .GetText End With End Function
[/vba]ну и написал макрос (в модуле листа) [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value = "" Then aa = u If aa <> "" Then ab = Replace(aa, ",", ".") If IsNumeric(ab) = False And aa <> "" Then ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then For ad = 1 To ac ae = InStr(ab, ".") af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If End If Target = Val(Replace(ab, " ", "")) Application.CutCopyMode = False End If End If End Sub
[/vba]скопируйте какую нибудь фигню похожую на число, выделите ячейку в M
апдэйт есть косяки, но сегодня уже не исправлюNic70y
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value = "" Then On Error Resume Next aa = u 'то, что в буфере If aa <> "" Then ab = Replace(aa, ",", ".") 'запятые заменяем точками (пример косяка 1,000) ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then 'выбрасываем разделители тысяч For ad = 1 To ac ae = InStr(ab, ".") af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then 'заменяем символы невходящие в Array пробелами For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If ca = Replace(ab, " ", "") 'убираем пробелы cb = Val(ca) If ca <> "" And IsNumeric(cb) Then 'если получили число, тогда Target = cb 'запишем его в ячейку End If Range("a1").Copy 'копируем ячейку (чтоб в буфере был excel) Application.CutCopyMode = False 'очищаем буфер End If End If End Sub
[/vba]
теперь все норм (но это не точно (с)) [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value = "" Then On Error Resume Next aa = u 'то, что в буфере If aa <> "" Then ab = Replace(aa, ",", ".") 'запятые заменяем точками (пример косяка 1,000) ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then 'выбрасываем разделители тысяч For ad = 1 To ac ae = InStr(ab, ".") af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then 'заменяем символы невходящие в Array пробелами For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If ca = Replace(ab, " ", "") 'убираем пробелы cb = Val(ca) If ca <> "" And IsNumeric(cb) Then 'если получили число, тогда Target = cb 'запишем его в ячейку End If Range("a1").Copy 'копируем ячейку (чтоб в буфере был excel) Application.CutCopyMode = False 'очищаем буфер End If End If End Sub
файл скачивали? там кроме макроса в модуле листа, есть еще удф в стандартном, о чем я писал в сооб#46 тестировал - работает
апдэйт, так будет лучше и без удф [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 13 Then Application.EnableEvents = False With Target aa = .Value .Clear '========================================== 'здесь прописать востановление форматов End With If aa <> "" Then ab = Replace(aa, ",", ".") 'запятые заменяем точками (пример косяка 1,000) ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then 'выбрасываем разделители тысяч For ad = 1 To ac ae = InStr(ab, ".") If ae > 0 Then af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag End If Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then 'заменяем символы невходящие в Array пробелами For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If ca = Replace(ab, " ", "") 'убираем пробелы cb = Val(ca) If ca <> "" And IsNumeric(cb) Then 'если получили число, тогда Target = cb 'запишем его в ячейку End If End If Application.EnableEvents = True End If End Sub
файл скачивали? там кроме макроса в модуле листа, есть еще удф в стандартном, о чем я писал в сооб#46 тестировал - работает
апдэйт, так будет лучше и без удф [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 13 Then Application.EnableEvents = False With Target aa = .Value .Clear '========================================== 'здесь прописать востановление форматов End With If aa <> "" Then ab = Replace(aa, ",", ".") 'запятые заменяем точками (пример косяка 1,000) ac = Len(aa) - Len(Replace(ab, ".", "")) - 1 If ac > 0 Then 'выбрасываем разделители тысяч For ad = 1 To ac ae = InStr(ab, ".") If ae > 0 Then af = Left(ab, ae - 1) ag = Mid(ab, ae + 1, 15) ab = af & ag End If Next End If ba = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9") bb = Len(ab) If bb > 0 Then 'заменяем символы невходящие в Array пробелами For bc = 1 To bb be = Mid(ab, bc, 1) bf = Application.Match(be, ba, 0) If IsNumeric(bf) = False Then ab = Replace(ab, be, " ") End If Next End If ca = Replace(ab, " ", "") 'убираем пробелы cb = Val(ca) If ca <> "" And IsNumeric(cb) Then 'если получили число, тогда Target = cb 'запишем его в ячейку End If End If Application.EnableEvents = True End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
