Макрос сравнения двух столбцов с условиями

@vikkrsk · Регистрация: 09.06.2016

Студворк — интернет-сервис помощи студентам

есть 5 столбцов в виде

1	300.00	900	900	180.00
3	800.00	902	901	0.00
4	402.00	903	902	268.00
5	231.00	905	903	0.00
6	350.00	906	906	309.00
7	261.00	907	907	0.00

надо сравнить третий с четвертым(могут быть любые два последовательных столбца) с условиями:
1- если оба равный переходим к следующей строке
2- если в третьем есть а в четвертом нет то в четвертый и все последующие столбцы вставляем пустые ячейки со смещением вниз
3- если в четвертом есть а в третьем нет то ко всем ячейкам до третей включительно вставляем пустые ячейки со смещением вниз
4- если оба пустые переходим к следующей строке при двукратном повторении останавливаем макрос

результат выполнения макроса

1	300.00	900	900	180.00
			901	0.00
3	800.00	902	902	268.00
4	402.00	903	903	0.00
5	231.00	905
6	350.00	906	906	309.00
7	261.00	907
			908	0.00

@KoGG · 09.06.2016, 12:07

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Выравнивание()
    Dim i&, k&
    Do
        i = i + 1
        If Cells(i, 3) > Cells(i, 4) And Cells(i, 4) > 0 Then
            Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ElseIf Cells(i, 3) < Cells(i, 4) And Cells(i, 3) > 0 Then
             Cells(i, 4).Resize(1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ElseIf Trim(Cells(i, 3)) & Trim(Cells(i, 4)) = "" Then
            k = k + 1
            If k > 1 Then Exit Do
        Else
            k = 0
        End If
    Loop
End Sub

@vikkrsk · 09.06.2016, 13:38 **[ТС]**

Спасибо огромное

Добавлено через 49 минут
код не выполняет условие
2- если в третьем есть а в четвертом нет то в четвертый и все последующие столбцы вставляем пустые ячейки со смещением вниз
он только две ячейки вниз смещает

@KoGG · 09.06.2016, 14:15

У меня на данном примере получилось точно то, что требовалось (если еще поменять D7 на 908).

Если работать с пустыми ячейками, то это условие проигнорировано, так как если оно срабатывает в последней строке, то получается бесконечный цикл.

Немного переделал для работы с пустыми ячейками, но может быть все равно неправильно, так как подобран плохой пример.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Выравнивание()
    Dim i&, k&, LastRow
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Do Until i > LastRow
        i = i + 1
        If Cells(i, 3) > Cells(i, 4) Then
            Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            LastRow = LastRow + 1
        ElseIf Cells(i, 3) < Cells(i, 4) Then
            Cells(i, 4).Resize(1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            LastRow = LastRow + 1
        ElseIf Trim(Cells(i, 3)) & Trim(Cells(i, 4)) = "" Then
            k = k + 1
            If k > 1 Then Exit Do
        Else
            k = 0
        End If
    Loop
End Sub

Если вместо некоторых чисел у Вас стоит текст, макрос будет работать неправильно.

@vikkrsk · 09.06.2016, 14:35 **[ТС]**

выдает ошибку
Compile error:
invalid or unqualified reference

LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

Добавлено через 4 минуты
общая структура таблицы вот такая

235,38	11217	11217	892	306.00	3	7	В наличии	1
346,34	11262	11262	893	450.00	3	7	В наличии	1
408,57	11263	11263	894	531.00	3	7	В наличии	1
207,73	11317	11311	895	268.00	0	8	Предзаказ	1
73,1	11320	11317	896	325.00	3	7	В наличии	1
73,1	11321	11319	897	0.00	0	8	Предзаказ	0

@KoGG · 09.06.2016, 14:43

Visual Basic
1
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

- однако второй вариант впадает в бесконечный цикл со 2-м набором данных.
Первый вариант работал правильно, чтобы смещал больше столбцов:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Выравнивание1()
    Dim i&, k&
    Do
        i = i + 1
        If Cells(i, 3) > Cells(i, 4) And Cells(i, 4) > 0 Then
            Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ElseIf Cells(i, 3) < Cells(i, 4) And Cells(i, 3) > 0 Then
             Cells(i, 4).Resize(1, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ElseIf Trim(Cells(i, 3)) & Trim(Cells(i, 4)) = "" Then
            k = k + 1
            If k > 1 Then Exit Do
        Else
            k = 0
        End If
    Loop
End Sub

@vikkrsk · 09.06.2016, 15:09 **[ТС]**

все работает,спасибо, а сможешь помочь еще вот с этой задачкой Макрос проверки столбцов с заменой значений

Новые блоги и статьи Все статьи Все блоги /
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .

@vikkrsk 0 / 0 / 0 Регистрация: 09.06.2016 Сообщений: 26
	09.06.2016, 13:38 [ТС]
	Спасибо огромное Добавлено через 49 минут код не выполняет условие 2- если в третьем есть а в четвертом нет то в четвертый и все последующие столбцы вставляем пустые ячейки со смещением вниз он только две ячейки вниз смещает 0

@vikkrsk 0 / 0 / 0 Регистрация: 09.06.2016 Сообщений: 26
	09.06.2016, 15:09 [ТС]
	все работает,спасибо, а сможешь помочь еще вот с этой задачкой Макрос проверки столбцов с заменой значений 0

Макрос сравнения двух столбцов с условиями

Решение