Здравствуйте. Подскажите в столбце а значения в столбце б значения Нужно проверить, все ли значения из столбца А есть в столбце Б и если каких то значений не хватает, то вывести их в msgbox или записать в какие то ячейки В приложенном документе есть макрос, где эти столбцы есть в массиве. Прошу продолжить макрос, ну или вариант с двумя массивами и если можно, то кометируйте, чтобы я мог разобраться потом:) просто это у меня часть макроса) более сложного,вот:) спасибо.
Здравствуйте. Подскажите в столбце а значения в столбце б значения Нужно проверить, все ли значения из столбца А есть в столбце Б и если каких то значений не хватает, то вывести их в msgbox или записать в какие то ячейки В приложенном документе есть макрос, где эти столбцы есть в массиве. Прошу продолжить макрос, ну или вариант с двумя массивами и если можно, то кометируйте, чтобы я мог разобраться потом:) просто это у меня часть макроса) более сложного,вот:) спасибо.best_vint
Быстро написать получилось только с циклом и использованием функций листа: [vba]
Код
Sub count_if() Dim A As Range, B As Range, rCell As Range, rA&, rB& With ActiveSheet rA = .Cells(.Rows.Count, 1).End(xlUp).Row ' Последняястрока в столбце А rB = .Cells(.Rows.Count, 2).End(xlUp).Row ' Последняястрока в столбце Б Set A = .Cells(1, 1).Resize(rA, 1) ' Диапазон столбца А Set B = .Cells(1, 2).Resize(rB, 1) ' Диапазон столбца Б
For Each rCell In B ' Для каждой ячейки из диапазона Б If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then ' Если количество совпадений значения ячейки из Б в диапазоне А равно нулю rCell.Interior.Color = 777777 ' закрашиваем ячейку (если совпадения нет) End If Next
End With End Sub
[/vba]
Быстро написать получилось только с циклом и использованием функций листа: [vba]
Код
Sub count_if() Dim A As Range, B As Range, rCell As Range, rA&, rB& With ActiveSheet rA = .Cells(.Rows.Count, 1).End(xlUp).Row ' Последняястрока в столбце А rB = .Cells(.Rows.Count, 2).End(xlUp).Row ' Последняястрока в столбце Б Set A = .Cells(1, 1).Resize(rA, 1) ' Диапазон столбца А Set B = .Cells(1, 2).Resize(rB, 1) ' Диапазон столбца Б
For Each rCell In B ' Для каждой ячейки из диапазона Б If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then ' Если количество совпадений значения ячейки из Б в диапазоне А равно нулю rCell.Interior.Color = 777777 ' закрашиваем ячейку (если совпадения нет) End If Next
адаптирова под себя, спасибо. подскажите, как понимать эту строку If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then если если что,то что? спасибо
о, спасибо, полезная вещь, буду пользоваться))
адаптирова под себя, спасибо. подскажите, как понимать эту строку If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then если если что,то что? спасибо
о, спасибо, полезная вещь, буду пользоваться))best_vint
Сообщение отредактировал best_vint - Четверг, 26.09.2013, 16:00
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value b = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) .Item(a(i, 1)) = i Next
For i = 1 To UBound(b) If Not .Exists(b(i, 1)) Then c(i, 1) = "не совпало" Else: c(i, 1) = "совпало" End If Next End With [c1].Resize(i - 1, 1).Value = c End Sub
[/vba]
вариант
[vba]
Код
Sub www() Dim a(), b(), c(), i&
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value b = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) .Item(a(i, 1)) = i Next
For i = 1 To UBound(b) If Not .Exists(b(i, 1)) Then c(i, 1) = "не совпало" Else: c(i, 1) = "совпало" End If Next End With [c1].Resize(i - 1, 1).Value = c End Sub
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value b = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) .Item(a(i, 1)) = i Next
For i = 1 To UBound(b) If Not .Exists(b(i, 1)) Then c(i, 1) = "не совпало" Else: c(i, 1) = "совпало" End If Next End With [c1].Resize(i - 1, 1).Value = c End Sub
я обычно цикл в цикле делаю, но подумал, наверняка есть варианты попроще:) SkyPro хорошую вот идею подсказал.)
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value b = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim c(1 To UBound(b), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) .Item(a(i, 1)) = i Next
For i = 1 To UBound(b) If Not .Exists(b(i, 1)) Then c(i, 1) = "не совпало" Else: c(i, 1) = "совпало" End If Next End With [c1].Resize(i - 1, 1).Value = c End Sub
я обычно цикл в цикле делаю, но подумал, наверняка есть варианты попроще:) SkyPro хорошую вот идею подсказал.)best_vint
SkyPro, твой макрос с использованием массива. [vba]
Код
Sub count_if() Dim A As Range, B As Range, rCell As Range, rA&, rB& Dim arr With ActiveSheet rA = .Cells(.Rows.Count, 1).End(xlUp).Row ' Последняястрока в столбце А rB = .Cells(.Rows.Count, 2).End(xlUp).Row ' Последняястрока в столбце Б Set A = .Cells(1, 1).Resize(rA, 1) ' Диапазон столбца А 'Set B = .Cells(1, 2).Resize(rB, 1) ' Диапазон столбца Б arr = .Cells(1, 2).Resize(rB, 1).Value 'For Each rCell In B ' Для каждой ячейки из диапазона Б For i = 1 To UBound(arr) ' для каждого элемента массива arr If Application.WorksheetFunction.CountIf(A, arr(i, 1)) = 0 Then ' If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then ' Если количество совпадений значения ячейки из Б в диапазоне А равно нулю ' rCell.Interior.Color = vbRed ' закрашиваем ячейку (если совпадения нет) Cells(i, 2).Interior.Color = vbRed ' закрашиваем ячейку (если совпадения нет) End If Next End With End Sub
[/vba]
SkyPro, твой макрос с использованием массива. [vba]
Код
Sub count_if() Dim A As Range, B As Range, rCell As Range, rA&, rB& Dim arr With ActiveSheet rA = .Cells(.Rows.Count, 1).End(xlUp).Row ' Последняястрока в столбце А rB = .Cells(.Rows.Count, 2).End(xlUp).Row ' Последняястрока в столбце Б Set A = .Cells(1, 1).Resize(rA, 1) ' Диапазон столбца А 'Set B = .Cells(1, 2).Resize(rB, 1) ' Диапазон столбца Б arr = .Cells(1, 2).Resize(rB, 1).Value 'For Each rCell In B ' Для каждой ячейки из диапазона Б For i = 1 To UBound(arr) ' для каждого элемента массива arr If Application.WorksheetFunction.CountIf(A, arr(i, 1)) = 0 Then ' If Application.WorksheetFunction.CountIf(A, rCell.Value) = 0 Then ' Если количество совпадений значения ячейки из Б в диапазоне А равно нулю ' rCell.Interior.Color = vbRed ' закрашиваем ячейку (если совпадения нет) Cells(i, 2).Interior.Color = vbRed ' закрашиваем ячейку (если совпадения нет) End If Next End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
