Страницы: 1
RSS
Проверка пустых ячеек в строке с помощью макроса
 
Здравствуйте! Нужна помощь в написании макроса.
вкратце - при заполнении шаблона нужна проверка пустых ячеек в строке и что бы выдавал всплывающее окно с подсказкой какие ячейки нужно заполнить
в шаблоне я описала подробнее задачу
Заранее благодарю!
Изменено: НатаААА - 12.07.2019 12:12:32
 
Наверное так:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
x = ""
    If Cells(Target.Row - 1, 6) = "Вакансия NEW" Then
        For i = 2 To 22
            Select Case i
                Case i = 2 To 10 And Cells(Target.Row - 1, i) = "", _
                14 To 20 And Cells(Target.Row - 1, i) = "", _
                22 And Cells(Target.Row - 1, i) = "": x = x & Cells(1, i) & Chr(10)
            End Select
        Next
    MsgBox "Не заполнены обязательные поля:" & Chr(10) & x
    End
    End If
End Sub
 
Еще вариант:
Код
Sub checkExplicitCells()
    Dim headersRn As Range, rrow As Range
    Dim explicitCellsMaskRn As Range, curRowBlankRn As Range, curRowExplicitMaskRn

    With ActiveSheet
        ' Диапазон заголовков. Отсюда будем брать названия и смотрим цвет ячеек. Желтые - обязательные
        Set headersRn = Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
                
        ' Определяем обязательные ячейки
        Set explicitCellsMaskRn = Nothing
        ' Пробегаемся по всем заголовкам и добавляем желтые в диапазон explicitCellsMaskRn
        For i = 1 To headersRn.Columns.Count
            If headersRn.Cells(1, i).Interior.Color = vbYellow Then
                If explicitCellsMaskRn Is Nothing Then
                    Set explicitCellsMaskRn = .Cells(1, i)
                Else
                    Set explicitCellsMaskRn = Union(explicitCellsMaskRn, .Cells(1, i))
                End If
            End If
        Next i
        
        ' Диапазон с типом (Вакансия) - с F3 и вниз до упора
        Set vacancyNewRange = Range(.Range("F3"), .Range("F3").End(xlDown))
        ' Пробегаемся вниз по диапазону, ищем Вакансия NEW
        For Each rrow In vacancyNewRange.Rows
            If rrow.Value = "Вакансия NEW" Then
                ' Сдвигаем диапазон explicitCellsMaskRn на текущую строку
                Set curRowExplicitMaskRn = explicitCellsMaskRn.Offset(rrow.Row - 1, 0)
               
                ' Если кол-во непустых ячеек в диапазоне меньше чем общее количество ячеек - значит что-то незаполнено
                If curRowExplicitMaskRn.Cells.Count - WorksheetFunction.CountA(curRowExplicitMaskRn) > 0 Then
                    ' Смотрим на каждую ячейку, пустые заносим в диапазон curRowBlankRn
                    For Each ccell In curRowExplicitMaskRn.Cells
                        If IsEmpty(ccell) Then
                            If curRowBlankRn Is Nothing Then
                                Set curRowBlankRn = ccell
                            Else
                                Set curRowBlankRn = Union(curRowBlankRn, ccell)
                            End If
                            txt = txt & IIf(txt <> "", ", ", "") & vbNewLine & headersRn.Cells(1, ccell.Column).Value
                        End If
                    Next ccell
                    
                    ' Красим curRowBlankRn в желтый и выделяем его
                    curRowBlankRn.Interior.Color = vbYellow
                    curRowBlankRn.Select
                    ' Выводим сообщение
                    MsgBox "Заполните пол" & IIf(curRowBlankRn.Cells.Count = 1, "е:", "я ") & txt, vbExclamation
                    
                    Set curRowBlankRn = Nothing
                    txt = ""
                End If
            End If
        Next rrow
    
    End With

End Sub
In GoTo we trust
 
Здравствуйте! Спасибо за помощь!!!
а если заголовок таблицы находится на 4 строке? В макросе, полагаю нужно где то внести изменение?  
 
НатаААА, в моем макросе так:

Код
     ' Диапазон заголовков. Отсюда будем брать названия и смотрим цвет ячеек. Желтые - обязательные
    Set headersRn = Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
на
    ' Диапазон заголовков. Отсюда будем брать названия и смотрим цвет ячеек. Желтые - обязательные
    Set headersRn = Range(.Cells(4, 1), .Cells(4, .Columns.Count).End(xlToLeft))

и тут:
Код
    ' Диапазон с типом (Вакансия) - с F3 и вниз до упора
    Set vacancyNewRange = Range(.Range("F3"), .Range("F3").End(xlDown))
на
    ' Диапазон с типом (Вакансия) - с F3 и вниз до упора
    Set vacancyNewRange = Range(.Range("F4"), .Range("F4").End(xlDown))
In GoTo we trust
 
Tolstak, спасибо!
ваш макрос можно использовать для любого файла?
Изменила в нем ячейки как написали, но что то он не работает...
Что мне проверить еще?
 
НатаААА, доработал код в паре мест.
Код
Sub checkExplicitCells()
    Dim headersRn As Range, rrow As Range, explicitCellsMaskRn As Range, curRowBlankRn As Range, curRowExplicitMaskRn

    With ActiveSheet
' Диапазон заголовков. Отсюда будем брать названия и смотрим цвет ячеек. Желтые - обязательные
    Set headersRn = Range(.Cells(4, 1), .Cells(4, .Columns.Count).End(xlToLeft))

' Диапазон с типом (Вакансия) - с F5 и вниз до упора
    Set vacancyNewRange = Range(.Range("F6"), .Range("F6").End(xlDown))


        ' Определяем обязательные ячейки
        Set explicitCellsMaskRn = Nothing
        ' Пробегаемся по всем заголовкам и добавляем желтые в диапазон explicitCellsMaskRn
        For i = 1 To headersRn.Columns.Count
            If headersRn.Cells(1, i).Interior.Color = vbYellow Then
                If explicitCellsMaskRn Is Nothing Then
                    Set explicitCellsMaskRn = headersRn.Cells(1, i)
                Else
                    Set explicitCellsMaskRn = Union(explicitCellsMaskRn, headersRn.Cells(1, i))
                End If
            End If
        Next i
        
        ' Пробегаемся вниз по диапазону, ищем Вакансия NEW
        For Each rrow In vacancyNewRange.Rows
            If rrow.Value = "Вакансия NEW" Then
                ' Сдвигаем диапазон explicitCellsMaskRn на текущую строку
                Set curRowExplicitMaskRn = explicitCellsMaskRn.Offset(rrow.Row - explicitCellsMaskRn.Row, 0)
               
                ' Если кол-во непустых ячеек в диапазоне меньше чем общее количество ячеек - значит что-то незаполнено
                If curRowExplicitMaskRn.Cells.Count - WorksheetFunction.CountA(curRowExplicitMaskRn) > 0 Then
                    ' Смотрим на каждую ячейку, пустые заносим в диапазон curRowBlankRn
                    For Each ccell In curRowExplicitMaskRn.Cells
                        If IsEmpty(ccell) Then
                            If curRowBlankRn Is Nothing Then
                                Set curRowBlankRn = ccell
                            Else
                                Set curRowBlankRn = Union(curRowBlankRn, ccell)
                            End If
                            
                            txt = txt & IIf(txt <> "", ", ", "") & vbNewLine & headersRn.Cells(1, ccell.Column).Areas(1).Cells(1).Value
                        End If
                    Next ccell
                    
                    ' Красим curRowBlankRn в желтый и выделяем его
                    curRowBlankRn.Interior.Color = vbYellow
                    curRowBlankRn.Select
                    ' Выводим сообщение
                    MsgBox "Заполните пол" & IIf(curRowBlankRn.Cells.Count = 1, "е:", "я ") & txt, vbExclamation
                    
                    Set curRowBlankRn = Nothing
                    txt = ""
                End If
            End If
        Next rrow
    End With
End Sub
In GoTo we trust
 
Tolstak, спасибо Вам большое! Все работает.
Еще небольшое уточнение-если хочу изменить цвет с желтого на светло-зеленый, где искать обозначение цветов?
Прям писать по-английски как есть?  
 
НатаААА, воспользуйтесь следующим макросом:
Код
Sub cellsColors()
    For Each ccell In Selection.Cells
        ccell.Value = ccell.Interior.Color
    Next ccell
End Sub

Можно использовать предопределенные цвета, вроде VbYellow (как в примере) - список тут.
Или скопируйте ячейку, выполните макрос, и подставьте в код вместо VbYellow номер цвета из ячейки.
In GoTo we trust
Страницы: 1
Наверх