я совсем забыл сказать, что для корректной работы моего кода нужно в свойствах комбобокса нужно очистить свойство LisFfillRange и установить MatchEntry fmMatchEntryNone , немного переписал код, добавил комментарии [vba]
Код
Private Sub ComboBox1_Change() Dim arr As Variant, r&, v As Variant With ComboBox1 If Len(.Value) Then 'пишем в массив значения из диапазона от C3 до последней непустой ячейки в C:C arr = Application.Transpose([c3].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3).Value) 'Application.Transpose нужен для получения горизонтального массива, 'ибо функция Filter с вертикальными массивами работать отказывается
On Error Resume Next 'отключаем отлов ошибок 'очищаем список: задаем список массивом, фильтрованным по значению в ComboBox1: разворачиваем список .List = Array(): .List = Filter(arr, IIf(Len(.Value), .Value, "џ"), 1, 1): .DropDown: DoEvents 'если список пуст или значение не задано, "жмем" Escape, чтобы его свернуть и завершаем процедуру End If If UBound(.List) < 0 Or Len(.Value) = 0 Then Application.SendKeys "{ESC}", 1: DoEvents: .Activate: Exit Sub 'если в ComboBox1 числовое значение, конвертируем в число 'число, записанное текстом, тоже распознается как числовое If IsNumeric(.Value) Then v = --.Value Else v = .Value Err.Clear 'очищаем информацию об ошибке 'ищем значение ComboBox1 в массиве, и прокручиваем лист до соответствующей ячейки Application.Goto Range("C3")(Application.Match(v, arr, 0)), 1 End With If Err = 0 Then 'если значение было найдено 'снимаем окрашивание со столбца Columns("C:C").Interior.Pattern = xlNone 'красим ячейку Selection.Interior.ColorIndex = 8 End If End Sub
[/vba]
я совсем забыл сказать, что для корректной работы моего кода нужно в свойствах комбобокса нужно очистить свойство LisFfillRange и установить MatchEntry fmMatchEntryNone , немного переписал код, добавил комментарии [vba]
Код
Private Sub ComboBox1_Change() Dim arr As Variant, r&, v As Variant With ComboBox1 If Len(.Value) Then 'пишем в массив значения из диапазона от C3 до последней непустой ячейки в C:C arr = Application.Transpose([c3].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3).Value) 'Application.Transpose нужен для получения горизонтального массива, 'ибо функция Filter с вертикальными массивами работать отказывается
On Error Resume Next 'отключаем отлов ошибок 'очищаем список: задаем список массивом, фильтрованным по значению в ComboBox1: разворачиваем список .List = Array(): .List = Filter(arr, IIf(Len(.Value), .Value, "џ"), 1, 1): .DropDown: DoEvents 'если список пуст или значение не задано, "жмем" Escape, чтобы его свернуть и завершаем процедуру End If If UBound(.List) < 0 Or Len(.Value) = 0 Then Application.SendKeys "{ESC}", 1: DoEvents: .Activate: Exit Sub 'если в ComboBox1 числовое значение, конвертируем в число 'число, записанное текстом, тоже распознается как числовое If IsNumeric(.Value) Then v = --.Value Else v = .Value Err.Clear 'очищаем информацию об ошибке 'ищем значение ComboBox1 в массиве, и прокручиваем лист до соответствующей ячейки Application.Goto Range("C3")(Application.Match(v, arr, 0)), 1 End With If Err = 0 Then 'если значение было найдено 'снимаем окрашивание со столбца Columns("C:C").Interior.Pattern = xlNone 'красим ячейку Selection.Interior.ColorIndex = 8 End If End Sub
Набираешь в окне ActiveX первые цифры/буквы, появляется выпадающее окно со списком из столбца С, который совпадает с набранными цифрами/буквами
[vba]
Код
Private Sub ComboBox1_Change() Dim arr As Variant, r& With ComboBox1 If Len(.Value) = 0 Then Exit Sub arr = Application.Transpose([c3].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3).Value) On Error Resume Next .List = Filter(arr, ComboBox1.Value): .DropDown: DoEvents If UBound(.List) < 0 Then Application.SendKeys "{ESC}", 1 r = Application.Match(IIf(IsNumeric(.Value), --.Value, .Value), arr, 0) If r Then Application.Goto Range("C3")(r), 1 End With End Sub
Набираешь в окне ActiveX первые цифры/буквы, появляется выпадающее окно со списком из столбца С, который совпадает с набранными цифрами/буквами
[vba]
Код
Private Sub ComboBox1_Change() Dim arr As Variant, r& With ComboBox1 If Len(.Value) = 0 Then Exit Sub arr = Application.Transpose([c3].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3).Value) On Error Resume Next .List = Filter(arr, ComboBox1.Value): .DropDown: DoEvents If UBound(.List) < 0 Then Application.SendKeys "{ESC}", 1 r = Application.Match(IIf(IsNumeric(.Value), --.Value, .Value), arr, 0) If r Then Application.Goto Range("C3")(r), 1 End With End Sub
По секрету всему свету ... у Range есть свойство .HasFormula [vba]
Код
Function SumConstants(rng As Range) Dim cell As Range For Each cell In rng.Cells SumConstants = SumConstants - (Not cell.HasFormula) * cell Next End Function
[/vba]
По секрету всему свету ... у Range есть свойство .HasFormula [vba]
Код
Function SumConstants(rng As Range) Dim cell As Range For Each cell In rng.Cells SumConstants = SumConstants - (Not cell.HasFormula) * cell Next End Function
Добрый день. Возможно в свойствах карты выбираем добавлять новые, после этого ПКМ по таблице xml>импорт , выбираем файлы, жмем Открыть, данные из файлов добавляются в таблицу, не заменяя существующие
Добрый день. Возможно в свойствах карты выбираем добавлять новые, после этого ПКМ по таблице xml>импорт , выбираем файлы, жмем Открыть, данные из файлов добавляются в таблицу, не заменяя существующиеkrosav4ig
Private Sub Worksheet_Change(ByVal Target As Range) With Application .EnableEvents = 0 If Not Intersect(Target, Me.[B:B], Me.UsedRange) Is Nothing Then Target.Offset(, 12) = .IfError(.VLookup(Target, [заказчики], 2, 0), "") End If .EnableEvents = 1 End With End Sub
[/vba]
можно так еще [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) With Application .EnableEvents = 0 If Not Intersect(Target, Me.[B:B], Me.UsedRange) Is Nothing Then Target.Offset(, 12) = .IfError(.VLookup(Target, [заказчики], 2, 0), "") End If .EnableEvents = 1 End With End Sub
Добрый день. Как-то по коду не очень понятно, чего нужно может так? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = 0 If Not Intersect(Target, Me.[B:B], Me.UsedRange) Is Nothing Then Target.Offset(, 12) = Application.VLookup(Target, [заказчики], 2, 0) End If Application.EnableEvents = 1 End Sub
[/vba]
Добрый день. Как-то по коду не очень понятно, чего нужно может так? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = 0 If Not Intersect(Target, Me.[B:B], Me.UsedRange) Is Nothing Then Target.Offset(, 12) = Application.VLookup(Target, [заказчики], 2, 0) End If Application.EnableEvents = 1 End Sub
задержался с ответом, ибо не было доступа к компьютеру в моем файле сводные автоматически обновляются макросом команды с нулевой суммой мест выводятся внизу списка
задержался с ответом, ибо не было доступа к компьютеру в моем файле сводные автоматически обновляются макросом команды с нулевой суммой мест выводятся внизу спискаkrosav4ig
Поздравляю с Днем Победы! Пусть ваша семья всегда живет под мирным небом, счастья, улыбок, смеха и радости, пусть никогда не придется вам и вашим близким познать горечь войны.
Поздравляю с Днем Победы! Пусть ваша семья всегда живет под мирным небом, счастья, улыбок, смеха и радости, пусть никогда не придется вам и вашим близким познать горечь войны.krosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
#Этнияоносамо
:
