Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как проверить на совпадение значений в ячейках столбца и совершить действие при несовпадении
 
#1
05.12.2019 12:23:35
Наверное, странно и непонятно звучит вопрос. Попробую объяснить мой вопрос на примере.
Есть список покупателей в следующем виде

Иванов - роза красная - 1
Иванов - роза голландская - 2
Иванов - тюльпан - 1
Иванов - хризантема - 3
Петров - роза красная - 1
Петров - хризантема - 3
Сидоров - роза красная - 3
Сидоров тюльпан - 4
Сидоров - хризантема - 2

(необольшое отступление. По факту это 3 заказа, 3 разных людей с несколькими позициями у каждого).
Сам вопрос. Как произвести итерацию по столбцу с фамилией и отделить разные заказы друг от друга, например отступлением в 3 строки? Чтобы на выходе получилось:
Иванов - роза красная - 1
Иванов - роза голландская - 2
Иванов - тюльпан - 1
Иванов - хризантема - 3

Петров - роза красная - 1
Петров - хризантема - 3

Сидоров - роза красная - 3
Сидоров тюльпан - 4
Сидоров - хризантема - 2

т.е. как реализовать алгоритм, который будет сравнивать текущую ячейку с предыдущей и в случае несовпадения совершать действие? В данном случае вставлять 2 строки
 
 
 
#2
05.12.2019 12:35:13
Код
Sub Совершить_действие_вставляющего_характера()
    Dim a As Variant
    a = Selection.Columns(1)
    Dim y As Long
    For y = UBound(a, 1) To 2 Step -1
        If a(y, 1) <> a(y - 1, 1) Then
            Selection.Rows(y).Resize(2).Insert Shift:=xlDown
        End If
    Next
End Sub
Выделите диапазон и запустите макрос.
 
 
 
#3
05.12.2019 17:03:50
МатросНаЗебре, спасибо за Ваш ответ. Ваше решение очень помогло. Не могли бы дать подсказки по вашему коду, правильно ли я всё понял. Вдруг придётся редактировать под свои потребности?
Код
Sub Совершить_действие_вставляющего_характера()
    Dim a As Variant //создаётся переменная a типа Variant (то есть тип данных не выбран)
    a = Selection.Columns(1) // a = выбранное сейчас значение (ячейка) в колонке 1
    Dim y As Long //создаётся тип данных типа long (целые числа)
    For y = UBound(a, 1) To 2 Step -1 //Цикл. Перебирается массив с колонкой a (т.е. первой) и двигается к 2 (те. Ubound(a,2)?? Почему шаг отрицательный? Перебор идёт с конца колонки? Где на это указание?
        If a(y, 1) <> a(y - 1, 1) Then //если значение y, 1 не равно y-1,1
            Selection.Rows(y).Resize(2).Insert Shift:=xlDown //вставить две строки выше текущей (y)
        End If
    Next
End Sub

Заранее спасибо
Изменено: Bel_Ami - 05.12.2019 17:08:20
 
 
 
#4
05.12.2019 17:17:07
Почему шаг отрицательный? "Таким образом не требуется изменять y при добавлении строк."
Перебор идёт с конца колонки? "Да"
Где на это указание? "Step -1"

В целом всё правильно, но есть кое-какие уточнения:
a = Selection.Columns(1) // a = выбранное сейчас значение (ячейка) в колонке 1
"a - это массив всех значений в колонке 1"

If a(y, 1) <> a(y - 1, 1) Then
"Другими словами, если значение в ячейке не равно значению из верхней ячейки."
 
 
 
#5
06.12.2019 08:54:19
А ещё можете (при условии, что у Вас разбивка данных везде через "-"), просто применить "Текст по столбцам" (вкладка Данные) с разделителем "-". И потом можно просто установить фильтр, или использовать сводную таблицу
 
 
 
#6
10.12.2019 13:38:32
Уважаемый [USER=40767]МатросНаЗебре[/USER, не могли бы вы подсказать, как переделать макрос, чтобы нужно было не выделять область, а чтобы сортировка происходила по определенной колонке? Допустим B?
 
 
 
#7
10.12.2019 13:45:53
Код
Sub Совершить_действие_вставляющего_характера()
    Dim r As Range
    Set r = Columns(2)
    
    Dim y As Long
    Dim a As Variant
    With r.Parent
        y = .Cells(.Rows.Count, r.Column).End(xlUp).Row
        a = .Range(.Cells(1, r.Column), .Cells(y, r.Column))
    End With
    
    For y = UBound(a, 1) To 2 Step -1
        If a(y, 1) <> a(y - 1, 1) Then
            r.Parent.Rows(y).Resize(2).Insert Shift:=xlDown
        End If
    Next
End Sub
 
 
 
#8
11.12.2019 11:30:50
Спасибо большое за ваши ответы МатросНаЗебре. По-моему вы очень хорошо шарите, можно я обнаглею и последний раз попрошу Вас о помощи (уже не по теме топика). Больше так делать не буду, честно :)

Фамилия - товарная позиция - кол-во - цена товарной позиции - - общая сумма по товарной позиции - общая сумма заказа

Иванов - роза красная - 1 - 200 - 200 - (1400)
Иванов - роза голландская - 2 - 100 - 200 - (1400)
Иванов - тюльпан - 1 - 100 - 100 - (1400)
Иванов - хризантема - 3 -300 - 900 - (1400)

Петров - роза красная - 1 - 200 - 200 - (1100)
Петров - хризантема - 3 - 300 - 900 - (1100)

Сидоров - роза красная - 3 - 200 - 600 - (1600)
Сидоров тюльпан - 4 - 100 - 400 - (1600)
Сидоров - хризантема - 2 - 300 - 600 - (1600)

В скобках указана цифра, которой нет, но которую нужно найти и прописать. Понятно, что сначала где-то нужно посчитать общую сумму по каждой товарной позиции, потом сложить эти суммы, а как вывести все эти суммы только только напротив тех строк, которые относятся к данному заказу
 
 
 
#9
11.12.2019 11:36:03
есть еще козыри в рукаве?
или ...
лучше еще подождать, пока все не выложите
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
11.12.2019 11:51:08
Код
Sub Вставить_и_посчитать()
    Dim r As Range
    Set r = Columns(2)
     
    Dim y As Long
    Dim a As Variant
    With r.Parent
        y = .Cells(.Rows.Count, r.Column).End(xlUp).Row
        a = .Range(.Cells(1, r.Column), .Cells(y, r.Column))
    End With
     
    For y = UBound(a, 1) To 1 Step -1
        r.Cells(y, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
        r.Cells(y, 6).FormulaR1C1 = "=SUMIFS(C[-1],C[-5],C[-5])"
        If y > 1 Then
            If a(y, 1) <> a(y - 1, 1) Then
                r.Parent.Rows(y).Resize(2).Insert Shift:=xlDown
            End If
        End If
    Next
    r.CurrentRegion.Calculate
End Sub
Тут принято "одна задача - одна тема". Лучше было бы оформить отдельной темой.
 
 
 
#11
11.12.2019 11:56:05
Цитата
МатросНаЗебре написал:
Тут принято "одна задача - одна тема". Лучше было бы оформить отдельной темой.




Прошу прощения, спасибо большое!
 
 
 
#12
11.12.2019 11:56:50
Цитата
Ігор Гончаренко написал:
есть еще козыри в рукаве? или ...лучше еще подождать, пока все не выложите
Если честно - есть :)
 
 
 
Страницы: 1
Наверх