Здравствуйте, уважаемые, недавно мне сделали макрос, но мной была упущено одно условие, при котором нужно изменить макрос. Проблема в том, что, когда макрос работает, он дублирует даты посещений, чтобы этого не было нужно прописать в нём, чтобы он добавлял даты на другой лист, если стоит в столбце O стоит услуга "Выезд".
Здравствуйте, уважаемые, недавно мне сделали макрос, но мной была упущено одно условие, при котором нужно изменить макрос. Проблема в том, что, когда макрос работает, он дублирует даты посещений, чтобы этого не было нужно прописать в нём, чтобы он добавлял даты на другой лист, если стоит в столбце O стоит услуга "Выезд".Kioto
Public Sub tt() Dim wsh1 As Worksheet, wsh2 As Worksheet Dim i As Long, rowLast&, rowCurr&, clnUslug& Dim rng1 As Range Dim oDict As Object
Set wsh1 = Worksheets("Лист1") wsh1.Activate wsh1.Cells(1, 1).Select
Set rng1 = wsh1.Cells.Find(What:="услуга", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If rng1 Is Nothing Then Exit Sub clnUslug = rng1.Column Set rng1 = wsh1.Cells.Find(What:="ФИО", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If rng1 Is Nothing Then Exit Sub rowLast = wsh1.Cells(Rows.Count, rng1.Column).End(xlUp).Row Set oDict = CreateObject("Scripting.Dictionary")
With wsh1
Set wsh2 = Worksheets.Add(After:=wsh1) .Cells(1, rng1.Column).Copy wsh2.Cells(1, 1) 'копируем заголовки .Cells(1, 7).Copy wsh2.Cells(1, 2) .Cells(1, 12).Copy wsh2.Cells(1, 3) .Cells(1, 10).Copy wsh2.Cells(1, 4) .Cells(1, 2).Copy wsh2.Cells(1, 5) rowCurr = 2 For i = 2 To rowLast If .Cells(i, clnUslug).Value = "выезд" Then
Public Sub tt() Dim wsh1 As Worksheet, wsh2 As Worksheet Dim i As Long, rowLast&, rowCurr&, clnUslug& Dim rng1 As Range Dim oDict As Object
Set wsh1 = Worksheets("Лист1") wsh1.Activate wsh1.Cells(1, 1).Select
Set rng1 = wsh1.Cells.Find(What:="услуга", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If rng1 Is Nothing Then Exit Sub clnUslug = rng1.Column Set rng1 = wsh1.Cells.Find(What:="ФИО", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If rng1 Is Nothing Then Exit Sub rowLast = wsh1.Cells(Rows.Count, rng1.Column).End(xlUp).Row Set oDict = CreateObject("Scripting.Dictionary")
With wsh1
Set wsh2 = Worksheets.Add(After:=wsh1) .Cells(1, rng1.Column).Copy wsh2.Cells(1, 1) 'копируем заголовки .Cells(1, 7).Copy wsh2.Cells(1, 2) .Cells(1, 12).Copy wsh2.Cells(1, 3) .Cells(1, 10).Copy wsh2.Cells(1, 4) .Cells(1, 2).Copy wsh2.Cells(1, 5) rowCurr = 2 For i = 2 To rowLast If .Cells(i, clnUslug).Value = "выезд" Then
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
