есть файл под названием "1-1" он будет содержать макрос, нужно создать макрос, чтобы он из файла "ЮЛ" копировал строки по 2 условиям в лист 2 содержащие часть слова "недвиж" столбца D и сумма столбца Q больше или равна 3 000 000 руб. выделенны желтым цветом столбцы
есть файл под названием "1-1" он будет содержать макрос, нужно создать макрос, чтобы он из файла "ЮЛ" копировал строки по 2 условиям в лист 2 содержащие часть слова "недвиж" столбца D и сумма столбца Q больше или равна 3 000 000 руб. выделенны желтым цветом столбцыNICK31
[/vba] Но циклы нужно бы сделать "автонастраиваемые", а не привязанные строго к диапазонам.
Да - если строк вдруг десятки тысяч, то хотя бы перебор и сравнение я бы делал на массивах. Да и вообще всё на массивах - а текстовый формат нужным столбцам можно отдельно перед выгрузкой данных задать.
Помнится, Вы говорили, что ничего менять не можете, что так приходит?
Ага, дело шатко-валко пошло... И данные в порядок привели. Замените основную строку на эту: [vba]
[/vba] Но циклы нужно бы сделать "автонастраиваемые", а не привязанные строго к диапазонам.
Да - если строк вдруг десятки тысяч, то хотя бы перебор и сравнение я бы делал на массивах. Да и вообще всё на массивах - а текстовый формат нужным столбцам можно отдельно перед выгрузкой данных задать.
Помнится, Вы говорили, что ничего менять не можете, что так приходит?Hugo
вот хотелось бы чтобы при изменении данных в таблице, ну например захотел я проверить строчку, сам подписал слово недвижимость и нажал на макрос! он бы мне переписал заново на лист 2 все данные и + новое!
вот хотелось бы чтобы при изменении данных в таблице, ну например захотел я проверить строчку, сам подписал слово недвижимость и нажал на макрос! он бы мне переписал заново на лист 2 все данные и + новое!NICK31
Добавил костыли - не нравится мне этот код. Но как объект изучения для начала сойдёт... [vba]
Code
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim n As Integer n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 110 If .Cells(i, 4) Like "*" & a1 & "*" And .Cells(i, 17) >= a2 Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If Next i End With End With Application.ScreenUpdating = True End Sub
[/vba]
P.S. почистил тему.
Добавил костыли - не нравится мне этот код. Но как объект изучения для начала сойдёт... [vba]
Code
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim n As Integer n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 110 If .Cells(i, 4) Like "*" & a1 & "*" And .Cells(i, 17) >= a2 Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If Next i End With End With Application.ScreenUpdating = True End Sub
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim n As Integer n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 1000 temp = Replace(.Cells(i, 17), " ", "") temp = Replace(temp, ChrW(160), "") If IsNumeric(temp) Then If --temp >= a2 Then If .Cells(i, 4) Like "*" & a1 & "*" Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If End If End If Next i End With End With Application.ScreenUpdating = True End Sub
[/vba] В B2 пишите число 3000000, никаких "000000000000000000003 000 000.00"
Такс, вот код:
[vba]
Code
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim n As Integer n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 1000 temp = Replace(.Cells(i, 17), " ", "") temp = Replace(temp, ChrW(160), "") If IsNumeric(temp) Then If --temp >= a2 Then If .Cells(i, 4) Like "*" & a1 & "*" Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If End If End If Next i End With End With Application.ScreenUpdating = True End Sub
[/vba] В B2 пишите число 3000000, никаких "000000000000000000003 000 000.00"Hugo
Проверил - у меня всё отрабатывает как нужно. Возможно, косяк в десятичных разделителях - у меня в системе/Экселе используются точки. Через часик поправлю - обед дело святое
Проверил - у меня всё отрабатывает как нужно. Возможно, косяк в десятичных разделителях - у меня в системе/Экселе используются точки. Через часик поправлю - обед дело святое Hugo
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim sep$, n As Integer sep_ = Mid(1 / 2, 2, 1) n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 1000 temp = Replace(.Cells(i, 17), " ", "") temp = Replace(temp, ChrW(160), "") temp = Replace(temp, ".", sep_) If IsNumeric(temp) Then If --temp >= a2 Then If .Cells(i, 4) Like "*" & a1 & "*" Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If End If End If Next i End With End With Application.ScreenUpdating = True End Sub
[/vba] И сохраняет, и не закрывает. Кстати, так было всегда.
Попытка №5... [vba]
Code
Sub copy_by_2_conditions() a1 = Range("A2").Value a2 = Range("B2").Value iPath$ = ActiveWorkbook.Path & "\" iFile$ = Dir(iPath$ & "ЮЛ.xls") iList1$ = "Лист1" iList2$ = "Лист2" If iFile$ = "" Then MsgBox "Не найден файл! ОПЕРАЦИЯ ПРЕРВАНА" Exit Sub End If Application.ScreenUpdating = False
Dim sep$, n As Integer sep_ = Mid(1 / 2, 2, 1) n = 0
With GetObject(iPath$ & iFile$) .Windows(1).Visible = True With .Sheets(iList1$) For i = 5 To 1000 temp = Replace(.Cells(i, 17), " ", "") temp = Replace(temp, ChrW(160), "") temp = Replace(temp, ".", sep_) If IsNumeric(temp) Then If --temp >= a2 Then If .Cells(i, 4) Like "*" & a1 & "*" Then n = n + 1 .Rows(i).Copy .Parent.Sheets(iList2$).Rows(n).Cells(1) End If End If End If Next i End With End With Application.ScreenUpdating = True End Sub
[/vba] И сохраняет, и не закрывает. Кстати, так было всегда.Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
