Очередной затык. Кодне выдает ошибок - это уже хорошо, но не работает...
[vba]
Код
Sub ЙЙЙЙ() Dim ar, ak, i, j ar = Range("первая") ak = Range("вторая") For i = 1 To UBound(ar) For j = 1 To UBound(ak) If ar(i, 2) = ak(j, 1) Then If ar(i, 3) = "Да" Then If ar(i, 4) > 20 Then ar(i, 1) = ak(j, 2) Exit For End If End If End If Next j Next i End Sub
[/vba]
Очередной затык. Кодне выдает ошибок - это уже хорошо, но не работает...
[vba]
Код
Sub ЙЙЙЙ() Dim ar, ak, i, j ar = Range("первая") ak = Range("вторая") For i = 1 To UBound(ar) For j = 1 To UBound(ak) If ar(i, 2) = ak(j, 1) Then If ar(i, 3) = "Да" Then If ar(i, 4) > 20 Then ar(i, 1) = ak(j, 2) Exit For End If End If End If Next j Next i End Sub
Вам нужно заполнить вторую таблицу датами из первой? Тогда
[vba]
Код
Sub ЙЙЙЙ() Dim ar, ak, i, j ar = Range("первая") ak = Range("вторая") For i = 1 To UBound(ar) For j = 1 To UBound(ak) If ar(i, 2) = ak(j, 1) Then If UCase(ar(i, 3)) = "ДА" Then '!!!! If ar(i, 4) > 20 Then ak(j, 2) = ar(i, 1) '!!!! Exit For End If End If End If Next j Next i Range("вторая") = ak '!!!! End Sub
Вам нужно заполнить вторую таблицу датами из первой? Тогда
[vba]
Код
Sub ЙЙЙЙ() Dim ar, ak, i, j ar = Range("первая") ak = Range("вторая") For i = 1 To UBound(ar) For j = 1 To UBound(ak) If ar(i, 2) = ak(j, 1) Then If UCase(ar(i, 3)) = "ДА" Then '!!!! If ar(i, 4) > 20 Then ak(j, 2) = ar(i, 1) '!!!! Exit For End If End If End If Next j Next i Range("вторая") = ak '!!!! End Sub
Просто с массивами мне хотя бы понятно как это работает более-менее, а по ссылке - дремучий лес.
У меня будут не такие большие объемы в ближайший год, в течение года, может быть и разберусь, когда с функционалом закончу и дойдут руки до оптимизации работы.
_Boroda_, Спасибо!
Просто с массивами мне хотя бы понятно как это работает более-менее, а по ссылке - дремучий лес.
У меня будут не такие большие объемы в ближайший год, в течение года, может быть и разберусь, когда с функционалом закончу и дойдут руки до оптимизации работы.AVI
Тема та же как и вопрос, но пример другой. И я все равно не понимаю как это работает. Чувствую себя тупым. Задача заполнить черную табличку данными из синей. И параллельно сделать так, что бы размер черной подстаривался под результат поиска. Посмотрел справку Ubound и Lbound. Понял разницу, но почему если менять Ubound на Lbound, то ничего не происходит? Это же важно. Пытаюсь сделать подумав - ничего не происходит. Пытаюсь сделать тупо по образу - тоже. Пытаюсь докопаться до истины и меняю местами [vba]
Код
For i = 1 To UBound(ar) For j = 1 To UBound(ak)
[/vba] Результат меняется, только почему он меняется?
Тема та же как и вопрос, но пример другой. И я все равно не понимаю как это работает. Чувствую себя тупым. Задача заполнить черную табличку данными из синей. И параллельно сделать так, что бы размер черной подстаривался под результат поиска. Посмотрел справку Ubound и Lbound. Понял разницу, но почему если менять Ubound на Lbound, то ничего не происходит? Это же важно. Пытаюсь сделать подумав - ничего не происходит. Пытаюсь сделать тупо по образу - тоже. Пытаюсь докопаться до истины и меняю местами [vba]
Код
For i = 1 To UBound(ar) For j = 1 To UBound(ak)
[/vba] Результат меняется, только почему он меняется?AVI
Sub bbb() Dim ar, ak, i, j Dim MyArr() ar = Range("Один") For i = 1 To UBound(ar) If ar(i, 1) > 10 Then j = j + 1 ReDim Preserve MyArr(1 To 2, 1 To j) MyArr(1, j) = ar(i, 1) MyArr(2, j) = ar(i, 2) End If Next i Range("Два").Resize(UBound(MyArr, 2), 2) = Application.Transpose(MyArr) End Sub
[/vba]
AVI, так? [vba]
Код
Sub bbb() Dim ar, ak, i, j Dim MyArr() ar = Range("Один") For i = 1 To UBound(ar) If ar(i, 1) > 10 Then j = j + 1 ReDim Preserve MyArr(1 To 2, 1 To j) MyArr(1, j) = ar(i, 1) MyArr(2, j) = ar(i, 2) End If Next i Range("Два").Resize(UBound(MyArr, 2), 2) = Application.Transpose(MyArr) End Sub
Мне дико не удобно, что я мусолю одну и ту же тему
Вообще-то это два совершенно разных вопроса, почти никак друг с другом не связанных С учетом того, что таблицу нужно перезаписывать и лишнее(если есть) стирать, получился такой код (для удобства там еще на листе выбор числа для сравнения и выбор > или <) [vba]
Код
Sub tt() ar0 = Range("Один") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем ar1 = Range("Два").Resize(n0_) 'массив из кол-ва строк как в первой таблице и кол-ва столбцов как во второй us_ = Range("N12") 'условие z_ = Range("O12") 'значение для сравнения znak_ = 1 'для > If us_ = "<" Then znak_ = -1 'для < For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) * znak_ > z_ * znak_ Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 2) 'заполняем n1-ую строку второго массива ar1(n1_, 2) = ar0(i, 3) 'заполняем n1-ую строку второго массива End If Next i Range("Два").ClearContents 'очищаем вторую таблицу With ActiveSheet.ListObjects("Два") 'работаем с ней как с объектом ad1_ = .Range(1).Address 'адрес первой ячейки таб 2 .Resize Range(ad1_).Resize(n1_ + 1, 2) 'изменяем размер таб 2 на столько строк, сколько n1_ + шапка .Range(1).Offset(1).Resize(n1_, 2) = ar1 'вставляем туда массив ar1 End With End Sub
Мне дико не удобно, что я мусолю одну и ту же тему
Вообще-то это два совершенно разных вопроса, почти никак друг с другом не связанных С учетом того, что таблицу нужно перезаписывать и лишнее(если есть) стирать, получился такой код (для удобства там еще на листе выбор числа для сравнения и выбор > или <) [vba]
Код
Sub tt() ar0 = Range("Один") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем ar1 = Range("Два").Resize(n0_) 'массив из кол-ва строк как в первой таблице и кол-ва столбцов как во второй us_ = Range("N12") 'условие z_ = Range("O12") 'значение для сравнения znak_ = 1 'для > If us_ = "<" Then znak_ = -1 'для < For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) * znak_ > z_ * znak_ Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 2) 'заполняем n1-ую строку второго массива ar1(n1_, 2) = ar0(i, 3) 'заполняем n1-ую строку второго массива End If Next i Range("Два").ClearContents 'очищаем вторую таблицу With ActiveSheet.ListObjects("Два") 'работаем с ней как с объектом ad1_ = .Range(1).Address 'адрес первой ячейки таб 2 .Resize Range(ad1_).Resize(n1_ + 1, 2) 'изменяем размер таб 2 на столько строк, сколько n1_ + шапка .Range(1).Offset(1).Resize(n1_, 2) = ar1 'вставляем туда массив ar1 End With End Sub
думал, Вам интересно будет посмотреть. Извините, погорячился, был неправ
[vba]
Код
Sub tt() ar0 = Range("Один") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 7 'первая строка во второй таблице (без шапки) r1_ = Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл If r1_ >= r0_ Then 'если табл 2 чем-то заполнена Cells(r0_, 11).Resize(r1_ - r0_ + 1, 2).Clear 'очищаем End If ar1 = Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) > 10 Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 2) 'заполняем ФИО второго массива ar1(n1_, 2) = ar0(i, 3) 'заполняем пол второго массива End If Next i Cells(r0_, 11).Resize(n1_, 2) = ar1 ' выводим во вторую таблицу столько строк массива аr1, сколько нашли в цикле проверки End Sub
думал, Вам интересно будет посмотреть. Извините, погорячился, был неправ
[vba]
Код
Sub tt() ar0 = Range("Один") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 7 'первая строка во второй таблице (без шапки) r1_ = Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл If r1_ >= r0_ Then 'если табл 2 чем-то заполнена Cells(r0_, 11).Resize(r1_ - r0_ + 1, 2).Clear 'очищаем End If ar1 = Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) > 10 Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 2) 'заполняем ФИО второго массива ar1(n1_, 2) = ar0(i, 3) 'заполняем пол второго массива End If Next i Cells(r0_, 11).Resize(n1_, 2) = ar1 ' выводим во вторую таблицу столько строк массива аr1, сколько нашли в цикле проверки End Sub
_Boroda_, Зря вы так. Сейчас, пока я щупаю азы для мне любой шаг в сторону - провал. Я мучал то, что Вы мне показывали до этого, а тут резко все по-другому. Поэтому и сложно. Для меня дико ценно то, что Вы пишите комментарии, за что я очень благодарен. Я понимаю как работает код в данном конкретном случае, но когда появляется необходимость, что-то существенно поменять, то сразу затык. Но, с другой стороны " глаза боятся, а руки делают". Вижу новые команды - лезу за справкой и в этом плане ваша помощь не менее ценна, ибо без нее я даже и не знал, что именно мне надо искать
_Boroda_, Зря вы так. Сейчас, пока я щупаю азы для мне любой шаг в сторону - провал. Я мучал то, что Вы мне показывали до этого, а тут резко все по-другому. Поэтому и сложно. Для меня дико ценно то, что Вы пишите комментарии, за что я очень благодарен. Я понимаю как работает код в данном конкретном случае, но когда появляется необходимость, что-то существенно поменять, то сразу затык. Но, с другой стороны " глаза боятся, а руки делают". Вижу новые команды - лезу за справкой и в этом плане ваша помощь не менее ценна, ибо без нее я даже и не знал, что именно мне надо искатьAVI
Вы молодец, что справку мучаете, но там не всегда нормально и понятно написано, поэтому не стесняйтесь здесь спрашивать. Тех, кто сам что-то пытается делать, здесь уважают и всегда помочь стараются.
И, кстати, задачи принципиально разные. В первой мы сравниваем значения из двух массивов (цикл в цикле или в словаре), а во второй проверка условия в одном массиве и вывод данных в другой. Поэтому конечно
Вы молодец, что справку мучаете, но там не всегда нормально и понятно написано, поэтому не стесняйтесь здесь спрашивать. Тех, кто сам что-то пытается делать, здесь уважают и всегда помочь стараются.
И, кстати, задачи принципиально разные. В первой мы сравниваем значения из двух массивов (цикл в цикле или в словаре), а во второй проверка условия в одном массиве и вывод данных в другой. Поэтому конечно
_Boroda_, А как заставить его переносить данные на нужный лист, а то он работает только на открытом листе.
И еще у меня Option Explicit о чем я ранее не сообщил.
[vba]
Код
Dim ar0, n0_, r0_, r1_, ar1, i, n1, n1_ As Long
ar0 = Range("РасшГруппНакл_tb") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 13 'первая строка во второй таблице (без шапки) r1_ = Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл If r1_ >= r0_ Then 'если табл 2 чем-то заполнена Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(r1_ - r0_ + 1, 1).Clear 'очищаем End If ar1 = Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) = "ДС" Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 3) 'заполняем ФИО второго массива End If Next i Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(n1_, 2) = ar1 ' выводим во вторую таблицу столько строк массива аr1, сколько нашли в цикле проверки
[/vba]
Сам разобрался - вроде работает
_Boroda_, А как заставить его переносить данные на нужный лист, а то он работает только на открытом листе.
И еще у меня Option Explicit о чем я ранее не сообщил.
[vba]
Код
Dim ar0, n0_, r0_, r1_, ar1, i, n1, n1_ As Long
ar0 = Range("РасшГруппНакл_tb") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 13 'первая строка во второй таблице (без шапки) r1_ = Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл If r1_ >= r0_ Then 'если табл 2 чем-то заполнена Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(r1_ - r0_ + 1, 1).Clear 'очищаем End If ar1 = Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) = "ДС" Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 3) 'заполняем ФИО второго массива End If Next i Worksheets("Отчет дневной стационар").Cells(r0_, 11).Resize(n1_, 2) = ar1 ' выводим во вторую таблицу столько строк массива аr1, сколько нашли в цикле проверки
сделает Long только переменную n1_/ Все остальные будут Variant. В VBA нужно писать обзывалку с "as" на каждую переменную отдельно 2. Почитайте про конструкцию With - End With. С ее помощью можно написать так (и компактнее, и легче читается, и быстрее работает) [vba]
Код
With Worksheets("Отчет дневной стационар") ar0 = Range("РасшГруппНакл_tb") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 13 'первая строка во второй таблице (без шапки) r1_ = .Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл !!!!! Здесь забыли указать лист !!!!! If r1_ >= r0_ Then 'если табл 2 чем-то заполнена .Cells(r0_, 11).Resize(r1_ - r0_ + 1, 1).Clear 'очищаем End If ar1 = .Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) = "ДС" Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 3) 'заполняем ФИО второго массива End If Next i .Cells(r0_, 11).Resize(n1_, 2) = ar1 End With
сделает Long только переменную n1_/ Все остальные будут Variant. В VBA нужно писать обзывалку с "as" на каждую переменную отдельно 2. Почитайте про конструкцию With - End With. С ее помощью можно написать так (и компактнее, и легче читается, и быстрее работает) [vba]
Код
With Worksheets("Отчет дневной стационар") ar0 = Range("РасшГруппНакл_tb") 'массив первой таблицы n0_ = UBound(ar0) 'кол-во строк в нем r0_ = 13 'первая строка во второй таблице (без шапки) r1_ = .Cells(Rows.Count, 11).End(3).Row ' последняя строка второй табл !!!!! Здесь забыли указать лист !!!!! If r1_ >= r0_ Then 'если табл 2 чем-то заполнена .Cells(r0_, 11).Resize(r1_ - r0_ + 1, 1).Clear 'очищаем End If ar1 = .Cells(r0_, 11).Resize(n0_, 2) 'пустой массив с кол-вом строк, как в первой таблице For i = 1 To n0_ 'цикл по строкам первой табл If ar0(i, 1) = "ДС" Then 'если условие выполнено, то n1_ = n1_ + 1 'счётчик увеличиваем на 1 ar1(n1_, 1) = ar0(i, 3) 'заполняем ФИО второго массива End If Next i .Cells(r0_, 11).Resize(n1_, 2) = ar1 End With
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
