Public Function VerSnils(snilstxt As String, v As Boolean) Dim i%, j%, ms$ Dim kt$, s$ Dim t t = Trim(snilstxt): kt = Right(t, 2) Do While InStr(1, t, "-") > 0 t = Replace(t, "-", "") Loop t = (Mid(t, 1, 9)) Do While InStr(1, t, " ") > 0 t = Replace(t, " ", "") Loop t = Val(t) For i = 1 To 9 j = j + (10 - i) * (t \ (10 ^ (9 - i)) Mod 10) Next i Select Case j Case 100, 101: s = "00" Case Is > 101: s = CStr(j Mod 101) Case Else: s = CStr(j) End Select If v Then VerSnils = CBool(IIf(kt = s, 1, 0)) Else VerSnils = s End If End Function
[/vba]
[vba]
Код
Public Function VerSnils(snilstxt As String, v As Boolean) Dim i%, j%, ms$ Dim kt$, s$ Dim t t = Trim(snilstxt): kt = Right(t, 2) Do While InStr(1, t, "-") > 0 t = Replace(t, "-", "") Loop t = (Mid(t, 1, 9)) Do While InStr(1, t, " ") > 0 t = Replace(t, " ", "") Loop t = Val(t) For i = 1 To 9 j = j + (10 - i) * (t \ (10 ^ (9 - i)) Mod 10) Next i Select Case j Case 100, 101: s = "00" Case Is > 101: s = CStr(j Mod 101) Case Else: s = CStr(j) End Select If v Then VerSnils = CBool(IIf(kt = s, 1, 0)) Else VerSnils = s End If End Function
это все потому, что проверка стоит снаружи цикла. Перенесите ее вовнутрь и будет все ок [vba]
Код
With Worksheets("Лист4").Range("H6:H" & j, "S6:S" & j) 'ищем в этих диапозонах Set result = .Find(What:=Worksheets("Лист3").Range("d2").Offset(r, 0).Value, LookIn:=xlValues) 'это хочу найти If Not result Is Nothing Then firstAddress = result.Address 'запоминаем адрес первой найденной ячейки Do If Worksheets("Лист3").Range("c2").Offset(r, 0).Value = result.Offset(0, 22).Value Then 'сравнение 'Обрабатываем найденную ячейку Worksheets("Лист3").Range("g2").Offset(r, 0).Value = result.Offset(0, -6).Value 'client End If Set result = .FindNext(result) 'ищем следующую Loop While Not result Is Nothing And result.Address <> firstAddress 'выход из цикла при переходе снова на первую End If End With
[/vba]
это все потому, что проверка стоит снаружи цикла. Перенесите ее вовнутрь и будет все ок [vba]
Код
With Worksheets("Лист4").Range("H6:H" & j, "S6:S" & j) 'ищем в этих диапозонах Set result = .Find(What:=Worksheets("Лист3").Range("d2").Offset(r, 0).Value, LookIn:=xlValues) 'это хочу найти If Not result Is Nothing Then firstAddress = result.Address 'запоминаем адрес первой найденной ячейки Do If Worksheets("Лист3").Range("c2").Offset(r, 0).Value = result.Offset(0, 22).Value Then 'сравнение 'Обрабатываем найденную ячейку Worksheets("Лист3").Range("g2").Offset(r, 0).Value = result.Offset(0, -6).Value 'client End If Set result = .FindNext(result) 'ищем следующую Loop While Not result Is Nothing And result.Address <> firstAddress 'выход из цикла при переходе снова на первую End If End With
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([C:C]) + 1 If Not Intersect(Target, [A1]) Is Nothing And _ Not (IsEmpty(Target)) And Target = [B1] Then Target.Copy [C:C].Cells(n, 1) End If End Sub
[/vba]
попробуйте перед строкой [vba]
Код
Target.Copy [B:C].Cells(n, 1)
[/vba] добавить строку [vba]
Код
Application.ScreenUpdating = 0
[/vba] если сравнивать с B1 то код вот такой
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([C:C]) + 1 If Not Intersect(Target, [A1]) Is Nothing And _ Not (IsEmpty(Target)) And Target = [B1] Then Target.Copy [C:C].Cells(n, 1) End If End Sub
ИМХО, вопрос по части vba. worksheet_change вам в помощь. вот примерный код если ячейка для ввода A1 и диапазон для накапливания значений и времени B:C
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([B:B]) + 1 If Not Intersect(Target, [A1]) Is Nothing And Not (IsEmpty(Target)) Then Target.Copy [B:C].Cells(n, 1) [B:C].Cells(n, 2) = Now() End If End Sub
[/vba]
ИМХО, вопрос по части vba. worksheet_change вам в помощь. вот примерный код если ячейка для ввода A1 и диапазон для накапливания значений и времени B:C
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([B:B]) + 1 If Not Intersect(Target, [A1]) Is Nothing And Not (IsEmpty(Target)) Then Target.Copy [B:C].Cells(n, 1) [B:C].Cells(n, 2) = Now() End If End Sub
Вот еще вариант с использованием таблицы. Выбор из списка подстановки в зел. ячейке. И еще обратите внимание на формулы разбивки длинных строк (в оранжевых ячейках)
Вот еще вариант с использованием таблицы. Выбор из списка подстановки в зел. ячейке. И еще обратите внимание на формулы разбивки длинных строк (в оранжевых ячейках)krosav4ig
может у вас ХМЕЛЬНИЦЬКИЙ в справочнике кодов на строке>500... тогда смотрите -2-4.xlsm, в нем обратите внимание на udf, новые имена и условное форматирование на листе с адресами (красными выделяются те ячейки, которые содержат "неправильные" буквы и символы). И в качестве бонуса в файле несколько небольших макросов.
может у вас ХМЕЛЬНИЦЬКИЙ в справочнике кодов на строке>500... тогда смотрите -2-4.xlsm, в нем обратите внимание на udf, новые имена и условное форматирование на листе с адресами (красными выделяются те ячейки, которые содержат "неправильные" буквы и символы). И в качестве бонуса в файле несколько небольших макросов.krosav4ig
, хоть и выглядят совершенно одинаково. И еще там где в названиях стоит апостроф, там обязательно должен быть апостроф '
Код
СИМВОЛ(39)
, а не одинарная кавычка ’
Код
СИМВОЛ(146)
И еще, если вдруг не знаете, украинские буквы І и і вводятся с клавиатуры комбинациями Alt+0178 и Alt+0179 соответственно, буквы Ї и і - Alt+0175 и Alt+0191, буквы Ґ и ґ Alt+0165 Alt+0180, буквы Є и є Alt+0170 и Alt+0186, апостроф можно ввести комбинацией Alt+0039 если не хочется переключаться на английскую раскладку. Буквы І, і, Ї, ї, Ґ, ґ, Є, є вводятся только с русской раскладки набором соответствующего кода на цифровой клавиатуре при зажатом Alt
Это все потому, что украинская І
Код
СИМВОЛ(178)
совсем не то же самое, что и английская I
Код
СИМВОЛ(73)
, хоть и выглядят совершенно одинаково. И еще там где в названиях стоит апостроф, там обязательно должен быть апостроф '
Код
СИМВОЛ(39)
, а не одинарная кавычка ’
Код
СИМВОЛ(146)
И еще, если вдруг не знаете, украинские буквы І и і вводятся с клавиатуры комбинациями Alt+0178 и Alt+0179 соответственно, буквы Ї и і - Alt+0175 и Alt+0191, буквы Ґ и ґ Alt+0165 Alt+0180, буквы Є и є Alt+0170 и Alt+0186, апостроф можно ввести комбинацией Alt+0039 если не хочется переключаться на английскую раскладку. Буквы І, і, Ї, ї, Ґ, ґ, Є, є вводятся только с русской раскладки набором соответствующего кода на цифровой клавиатуре при зажатом Altkrosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
(
