Доброго времени суток. Возник вопрос, пытаюсь сделать программу для заполнения вкладки ap данными с вкладки sv. То есть, если совпадает код точки (столбец С) и находится строка "Кол-во фэйсов Всего", данные по этой строке с вкладки sv из 15 столбца идут в 13 столбец вкладки ap. Но программа не работает. Если убрать одно из условий [vba]
Код
And sv.Cells(j, 10) = "Кол-во фэйсов Всего"
[/vba] Находится только одно значение. Не понимаю, что делаю не так. Видимо сказывается отсутствие опыта. Буду признателен за пинок в правильном направлении)
Доброго времени суток. Возник вопрос, пытаюсь сделать программу для заполнения вкладки ap данными с вкладки sv. То есть, если совпадает код точки (столбец С) и находится строка "Кол-во фэйсов Всего", данные по этой строке с вкладки sv из 15 столбца идут в 13 столбец вкладки ap. Но программа не работает. Если убрать одно из условий [vba]
Код
And sv.Cells(j, 10) = "Кол-во фэйсов Всего"
[/vba] Находится только одно значение. Не понимаю, что делаю не так. Видимо сказывается отсутствие опыта. Буду признателен за пинок в правильном направлении)thrasher
Sub find_values() Dim i&, j&, r_ap&, r_sv& r_ap = Sheets("ap").Cells(Rows.Count, 3).End(xlUp).Row r_sv = Sheets("sv").Cells(Rows.Count, 3).End(xlUp).Row For i = 4 To r_ap For j = 2 To r_sv If sv.Cells(j, 3).Value = ap.Cells(i, 3).Value And sv.Cells(j, 10) = "Кол-во фэйсов Всего" Then ap.Cells(i, 13).Value = sv.Cells(j, 15).Value End If Next j Next i End Sub
[/vba]
Проверяем! [vba]
Код
Sub find_values() Dim i&, j&, r_ap&, r_sv& r_ap = Sheets("ap").Cells(Rows.Count, 3).End(xlUp).Row r_sv = Sheets("sv").Cells(Rows.Count, 3).End(xlUp).Row For i = 4 To r_ap For j = 2 To r_sv If sv.Cells(j, 3).Value = ap.Cells(i, 3).Value And sv.Cells(j, 10) = "Кол-во фэйсов Всего" Then ap.Cells(i, 13).Value = sv.Cells(j, 15).Value End If Next j Next i End Sub
Wasilic, большое спасибо за ответ, все работает как надо. Сам про вложенный цикл не додумался бы. У меня еще вопрос, зачем рядом с переменными стоит знак амперсанда, что это означает?
Wasilic, большое спасибо за ответ, все работает как надо. Сам про вложенный цикл не додумался бы. У меня еще вопрос, зачем рядом с переменными стоит знак амперсанда, что это означает?thrasher
Мда, добавил еще 5 условий типа "Кол-во фэйсов Всего", прогнал на большом файле: ap-450,sv-15000 строк - время просчета 7 минут ожидал бОльшей скорости, скринапдейт отключен.
Мда, добавил еще 5 условий типа "Кол-во фэйсов Всего", прогнал на большом файле: ap-450,sv-15000 строк - время просчета 7 минут ожидал бОльшей скорости, скринапдейт отключен.thrasher
Sub ertert() Dim x, y(), j&, k&, r As Range, adr$, fc Dim col As New Collection
x = ap.Range("C4", ap.Cells(Rows.Count, 3).End(xlUp)).Value ReDim y(1 To UBound(x), 1 To 8) fc = ap.Range("I3:P3").Value
On Error Resume Next: Err.Clear For j = 1 To UBound(x) col.Add Item:=j, Key:=CStr(x(j, 1)) Next j
With sv.Columns(10) For j = 1 To UBound(fc, 2) If Len(fc(1, j)) Then Set r = .Find(fc(1, j), LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do If Not IsEmpty(col.Item(CStr(r(1, -6).Value))) Then k = col.Item(CStr(r(1, -6).Value)) y(k, j) = r(1, 6).Value End If Set r = .FindNext(r) Loop While r.Address <> adr End If End If Next j End With
ap.Range("I4:P4").Resize(UBound(y)).Value = y() End Sub
[/vba]
thrasher, привет попробуйте так:
[vba]
Код
Sub ertert() Dim x, y(), j&, k&, r As Range, adr$, fc Dim col As New Collection
x = ap.Range("C4", ap.Cells(Rows.Count, 3).End(xlUp)).Value ReDim y(1 To UBound(x), 1 To 8) fc = ap.Range("I3:P3").Value
On Error Resume Next: Err.Clear For j = 1 To UBound(x) col.Add Item:=j, Key:=CStr(x(j, 1)) Next j
With sv.Columns(10) For j = 1 To UBound(fc, 2) If Len(fc(1, j)) Then Set r = .Find(fc(1, j), LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do If Not IsEmpty(col.Item(CStr(r(1, -6).Value))) Then k = col.Item(CStr(r(1, -6).Value)) y(k, j) = r(1, 6).Value End If Set r = .FindNext(r) Loop While r.Address <> adr End If End If Next j End With
ap.Range("I4:P4").Resize(UBound(y)).Value = y() End Sub
Wasilic, спасибо за пинок) мой коммент был простой констатацией факта. К Вашему коду, это не имеет никакого отношения) nilem, спасибо, проверил - время выполнения 2 секунды единственная проблема, что я очень плохо понимаю этот код. Очень не хватает комментариев)
Wasilic, спасибо за пинок) мой коммент был простой констатацией факта. К Вашему коду, это не имеет никакого отношения) nilem, спасибо, проверил - время выполнения 2 секунды единственная проблема, что я очень плохо понимаю этот код. Очень не хватает комментариев)thrasher
Всем доброго времени суток. Разбираюсь с кодом Nilem, к сожалению вторая часть макроса тяжела для моего понимания, в силу отсутствия должного опыта. У меня возник вопрос, возможно ли упростить вторую часть кода? Сейчас поиск идет по маске fc (I3:P3), а если будет массив с этими данными или коллекция? Хотелось бы в итоге воспроизвести код с той же производительностью, но с более прозрачной для нубов логикой.
[vba]
Код
Sub ertert() Dim x, y(), j&, k&, r As Range, adr$, fc Dim col As New Collection
'1 x = ap.Range("C4", ap.Cells(Rows.Count, 3).End(xlUp)).Value 'находим последнюю строку в 3м столбце на вкладке AP ReDim y(1 To UBound(x), 1 To 8) 'Переназначаем переменную y - массив (от 1 до последней строки , fc (1 до 8)) fc = ap.Range("I3:P3").Value 'данные из шапки по которым идет поиск
On Error Resume Next: Err.Clear ' пропускаем и очищаем ошибки For j = 1 To UBound(x) 'цикл добавления в коллекцию значений из 3 столбца вкладки AP col.Add Item:=j, Key:=CStr(x(j, 1)) Next j
'2 With sv.Columns(10) For j = 1 To UBound(fc, 2) If Len(fc(1, j)) Then Set r = .Find(fc(1, j), LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do If Not IsEmpty(col.Item(CStr(r(1, -6).Value))) Then k = col.Item(CStr(r(1, -6).Value)) y(k, j) = r(1, 6).Value End If Set r = .FindNext(r) Loop While r.Address <> adr End If End If Next j End With
ap.Range("I4:P4").Resize(UBound(y)).Value = y() End Sub
[/vba]
Всем доброго времени суток. Разбираюсь с кодом Nilem, к сожалению вторая часть макроса тяжела для моего понимания, в силу отсутствия должного опыта. У меня возник вопрос, возможно ли упростить вторую часть кода? Сейчас поиск идет по маске fc (I3:P3), а если будет массив с этими данными или коллекция? Хотелось бы в итоге воспроизвести код с той же производительностью, но с более прозрачной для нубов логикой.
[vba]
Код
Sub ertert() Dim x, y(), j&, k&, r As Range, adr$, fc Dim col As New Collection
'1 x = ap.Range("C4", ap.Cells(Rows.Count, 3).End(xlUp)).Value 'находим последнюю строку в 3м столбце на вкладке AP ReDim y(1 To UBound(x), 1 To 8) 'Переназначаем переменную y - массив (от 1 до последней строки , fc (1 до 8)) fc = ap.Range("I3:P3").Value 'данные из шапки по которым идет поиск
On Error Resume Next: Err.Clear ' пропускаем и очищаем ошибки For j = 1 To UBound(x) 'цикл добавления в коллекцию значений из 3 столбца вкладки AP col.Add Item:=j, Key:=CStr(x(j, 1)) Next j
'2 With sv.Columns(10) For j = 1 To UBound(fc, 2) If Len(fc(1, j)) Then Set r = .Find(fc(1, j), LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do If Not IsEmpty(col.Item(CStr(r(1, -6).Value))) Then k = col.Item(CStr(r(1, -6).Value)) y(k, j) = r(1, 6).Value End If Set r = .FindNext(r) Loop While r.Address <> adr End If End If Next j End With
ap.Range("I4:P4").Resize(UBound(y)).Value = y() End Sub