Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
Добрый день! Написал код в VBA для отбора элементов (ненулевые, без повторов, столбец G) и расчет суммы по каждому элементу (аналогично суммесли). Код работает, но у меня есть вопрос - насколько я его правильно описал, такое ощущение, что усложнил код. Посмотрите, пожалуйста.
Код
Sub Condition_vibor4()

Dim i As Integer, j As Integer

'Описываем цикл
For i = 7 To 20 '7 - начало строки массива данных, а 20 - конец массива (можно заменить на "последнюю строку"

For j = 1 To 5 '1 - начальная строка для размещения данных, 5 - число зарезервированных строк под двнные

' условие для остановки макроса при достижении i = 20 и более
If i > 19 Then
End
End If
'

If Cells(i, 8) > 0 And Cells(j, 9) <> Cells(i, 7) And Cells(i, 7) <> Cells(i + 1, 7) Then
Cells(j, 9) = Cells(i, 7).Value
Cells(1, 10) = "=SumIf($G$7:$G$16,I1,$H$7:$H$16)"
i = i + 1
Else

If i = 18 Then
countvalues = Application.WorksheetFunction.CountA(Range("I1:I5"))
Cells(1, 10).Select
    Selection.AutoFill Destination:=Range("J1:J" & countvalues), Type:=xlFillDefault
End If

i = i + 1
j = j - 1
End If

Next j
Next i

End Sub


Спасибо!
 
Цитата
насколько я его правильно описал, такое ощущение, что усложнил код.
Усложнили и запутали. Особенно, если всё это только для заполнения нескольких ячеек формулой СУММЕСЛИ().
А Вы можете описать логику происходящего в макросе своими словами?

Из чисто стилистических ошибок:
1) "Магические" числа повсюду.
2) Отсутствие форматирования отступов для вложенных конструкций вроде циклов и ветвлений.
3) Путаница с объектами ячеек и их значениями.
4) Манипуляции с индексами цикла.
Эти вещи затрудняют чтение и понимание Вашего кода, мешая его отладке и дальнейшей разработке.
Изменено: Irregular Expression - 6 июн 2018 15:23:07
 
С какой целью выполняются вот эти действия
Код
i = i + 1
j = j - 1

у вас же переменные i и j участвуют в цикле счетчиками?
Зачем это в коде
Код
If i > 19 Then
End
End If

Сделайте первый цикл до 18 и этот кусок  кода не нужен.
"Все гениальное просто, а все простое гениально!!!"
 
Спасибо за отклики! По порядкуэ

Задача макроса: собрать ненулевые значения из колонки H, и записать элементы к которым относятся (в данном случае A, B и С). Фактически я хочу добиться вычислений из сводной таблицы, но без доп. листов, использования доп. ячеек и ненужной информации из свода (итого и т.д.). Понятно, что макрос работает только с отсортированными данными (A, B , С и т.д.), но я так и буду использовать.

Nordheim,
Код
i = i + 1
j = j - 1
Мне нужно, чтобы макрос шел по строкам вперед, без i=i+1 он оставит значение i прежним. А j=j-1, контролирует заполнение ячеек подряд в столбце, если не будет этой строки будут "бланки".
Код
If i > 19 Then
End
End If
Я планирую заменить 19 на макрос последней строки для колонки G. Без этой проверки у меня цикл "зацикливался" (не мог завершиться).
Изменено: Macedon - 6 июн 2018 18:51:16
 
Цитата
Macedon написал: без i=i+1 он оставит значение i прежним
Вы уверены? Пройдите Ваш цикл по-шагово (без этой строки) и убедитесь в обратном.
У Вас пока отсутствуют даже базовые знания по циклам. Подучите мат.часть
Согласие есть продукт при полном непротивлении сторон.
 
Цитата
Macedon написал: собрать ненулевые значения из колонки H, и записать элементы к которым относятся (в данном случае A, B и С).
Так?
Код
Sub Condition_vibor4()
Dim i&, MySum As Long
For i = 7 To 20
    If Cells(i, 7) = "A" Or Cells(i, 7) = "B" Or Cells(i, 7) = "C" Then
        MySum = MySum + Cells(i, 8)
    End If
Next
Cells(1, 10) = MySum
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja,нет, этот код для суммы элементов. Я F8 проходил не раз, прежде чем писать на форум.

Код
Sub Condition_vibor4()
Dim i&, MySum As Long
For i = 7 To 20
    If Cells(i, 7) = "A" Or Cells(i, 7) = "B" Or Cells(i, 7) = "C" Then
        MySum = MySum + Cells(i, 8)
    End If
Next
Cells(1, 10) = MySum
End Sub

Update: мой код тоже не работает :( , если будет ряд из:

A
A
A789
B80
C8
C
F564
E23
D789
Изменено: Macedon - 6 июн 2018 16:47:53
 
Цитата
Macedon написал: код тоже не работает
Покажите в файле Как есть - Как надо (желаемый результат). И опишите задачу обычными, русскими, словами, без привязки к VBA и циклам в частности
Согласие есть продукт при полном непротивлении сторон.
 
Фактически нужен результат свода.
 
Цитата
Macedon написал:
Задача макроса: собрать ненулевые значения из колонки H, и записать элементы к которым относятся (в данном случае A, B и С).
Оптимально использовать макрос со словарём (погуглите на тему использование объекта Scripting.Dictionary в VBA). Столбец G - в ключи, столбец H - в значения (при наличии элемента с заданным ключом в словаре, значения просуммировать).
Вывести получившийся словарь в нужный диапазон ячеек.
Если обязательна запись на выходе формул, а не значений, то в значения словаря добавлять порядковый номер элемента.

Либо записать диапазон G7:H16 в массив и перебрать одним циклом For...Next. Два цикла, как у Вас, тут абсолютно без надобности, т.к. столбцов всего два и они отличаются на единицу.
Цитата
Macedon написал:
Мне нужно, чтобы макрос шел по строкам вперед, без i=i+1 он оставит значение i прежним. А j=j-1, контролирует заполнение ячеек подряд в столбце, если не будет этой строки будут "бланки".
С чего Вы взяли? Цикл For... Next - перебирает все целые значения индекса от начального до конечного. Если Вам нужно, чтобы цикл "перепрыгивал" через значение, то просто для него укажите параметр Step, а не меняйте индекс внутри цикла:
Код
For i = 0 To 10
   i = i + 1
Next i
'Равносильно:
For i = 0 To 10 Step 2
   'i = 0, 2, 4, ... 10
Next i

Цитата
Macedon написал:
Без этой проверки у меня цикл "зацикливался" (не мог завершиться).
Немного уличной магии в Вашем коде, или почему "зацикливается цикл":
Код
For j = 1 To 10 'пока j не равно 10, выполняется j = j + 1 на каждом проходе цикла.
   j = j - 1 'Возврат индекса на значение при прошлом шаге. 
Next j
Итог: зависание цикла. Вывод: не надо в теле цикла For...Next менять переменную его индекса. Если нужно сделать изменение индекса явным и выходить из него по условию, используйте циклы Do...While или While...Wend.
Изменено: Irregular Expression - 6 июн 2018 17:19:38
 
Цитата
Macedon написал:
Я F8 проходил не раз, прежде чем писать на форум.
Macedon, относительно i = i + 1 Вы ошибаетесь. Попробуйте убрать эту строчку и пройдите ЕЩЁ раз пошагово.
i - это счётчик цикла и по умолчанию у него шаг равен единице. Т.е. на каждой итерации цикла значение этой перменной увеличивается на единичку. Без Вашей "помощи" ))
 
Форумчане, спасибо Вам за помощь (кто - советом, кто - делом), я похоже решил задачу с помощью нового кода (оставлю его как решение своего вопроса). Код собран на основе данной темы, чуть модифицирован на проверку условия (не равно "").

Код
Sub Condition_vibor4()

 'процедура формируем массив уникальных значений в выбранном диапазоне и вставляем его в указанную ячейку
    Dim cell As Range
    Dim Unique As New Collection
    Dim cellPaste As Range
    Dim UniqueArray()
            
    Dim A() As String
    Dim C As Collection
    Dim R As Range
    Dim I As Long
    
    Set C = New Collection
    
    On Error Resume Next
    For Each R In Worksheets("Sheet1").Range("G7:G16").Cells
        If R.Offset(0, 1) <> "" Then
        C.Add R.Value, CStr(R.Value)
        End If
    Next
    On Error GoTo 0
     
ReDim UniqueArray(1 To C.Count, 1 To 1)
   'переносим уникальные значения в массив
        For I = 1 To C.Count
            UniqueArray(I, 1) = C.Item(I)
        Next I
'определяем диапазон для вставки
    Set cellPaste = Range(Cells(1, 11), Cells(1, 11).Offset(C.Count - 1, 0))
   'вставляем массив в диапазон
' при вставке я пытался избежать цыкла (рекомендация одного автора учебника по VBA с примером).
' во всем диапазоне для вставки я получаю только первое значание массива
        cellPaste.Value = UniqueArray
     
Cells(1, 12) = "=SumIf($G$7:$G$16,K1,$H$7:$H$16)"
Cells(1, 12).Select
    Selection.AutoFill Destination:=Range("L1:L" & C.Count), Type:=xlFillDefault

End Sub

Страницы: 1
Читают тему (гостей: 1)
Наверх