Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос на поиск незаполненных ячеек, доработка макроса - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос на поиск незаполненных ячеек, доработка макроса (Макросы/Sub)
Макрос на поиск незаполненных ячеек, доработка макроса
pentagon63 Дата: Вторник, 07.05.2019, 10:10 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Всем привет! Нашел макрос, который проверяет определенные ячейки на заполненность, если не заполнено,то не дает сохранять, проблема в том,что слишком много значений и не дает запускать макрос, так как описан только столбец G, то есть еще столбец H,I,T,Yи т.д. с точно такой же нумерацией, написан макрос далеко не самым лучшим способом, помогите заставить его работать)

[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
For Each r In Sheets(1).Range("G2,G4,G6,G8,G10,G12,G14,G16,G18,G20,G22,G24,G26,G28,G30,G32,G34,G36,G38,G40,G42,G42,G44,G46,G48,G50,G52,G54,G56,G58,G60
,G62,G64,G66,G68,G70,G72,G74,G76,G78,G80,G82,G84,G86,G88,G90,G92,G94,G96,G98,G100,G102,G104,G106,H2,H4,H6,H8,H10,
H12,H14,H16,H18,H20,H22,H24,H26,H28,H30").Cells
If r = "" Then
If InputBox("не сохраню") <> "123" Then
Cancel = True: Exit For
Else
Exit Sub
End If
End If
Next
End Sub
[/vba]


бееедаааа

Сообщение отредактировал pentagon63 - Вторник, 07.05.2019, 10:41
 
Ответить
СообщениеВсем привет! Нашел макрос, который проверяет определенные ячейки на заполненность, если не заполнено,то не дает сохранять, проблема в том,что слишком много значений и не дает запускать макрос, так как описан только столбец G, то есть еще столбец H,I,T,Yи т.д. с точно такой же нумерацией, написан макрос далеко не самым лучшим способом, помогите заставить его работать)

[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
For Each r In Sheets(1).Range("G2,G4,G6,G8,G10,G12,G14,G16,G18,G20,G22,G24,G26,G28,G30,G32,G34,G36,G38,G40,G42,G42,G44,G46,G48,G50,G52,G54,G56,G58,G60
,G62,G64,G66,G68,G70,G72,G74,G76,G78,G80,G82,G84,G86,G88,G90,G92,G94,G96,G98,G100,G102,G104,G106,H2,H4,H6,H8,H10,
H12,H14,H16,H18,H20,H22,H24,H26,H28,H30").Cells
If r = "" Then
If InputBox("не сохраню") <> "123" Then
Cancel = True: Exit For
Else
Exit Sub
End If
End If
Next
End Sub
[/vba]

Автор - pentagon63
Дата добавления - 07.05.2019 в 10:10
boa Дата: Вторник, 07.05.2019, 11:56 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 397
Репутация: 110 ±
Замечаний: 0% ±

2013, 365
pentagon63,
наверное так
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sCol, iRow&
    For Each sCol In Array("G", "H", "I", "T", "Y") 'и т.д.
        For iRow = 2 To 106 Step 2
            If Sheets(1).Range(sCol & iRow) = "" Then
                If InputBox("не сохраню") <> "123" Then
                    Cancel = True: Exit For
                Else
                    Exit Sub
                End If
            End If
        Next
    Next
End Sub
[/vba]




Сообщение отредактировал boa - Вторник, 07.05.2019, 11:57
 
Ответить
Сообщениеpentagon63,
наверное так
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sCol, iRow&
    For Each sCol In Array("G", "H", "I", "T", "Y") 'и т.д.
        For iRow = 2 To 106 Step 2
            If Sheets(1).Range(sCol & iRow) = "" Then
                If InputBox("не сохраню") <> "123" Then
                    Cancel = True: Exit For
                Else
                    Exit Sub
                End If
            End If
        Next
    Next
End Sub
[/vba]

Автор - boa
Дата добавления - 07.05.2019 в 11:56
K-SerJC Дата: Вторник, 07.05.2019, 12:10 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 440
Репутация: 72 ±
Замечаний: 0% ±

Excel 2013
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim f, k, сl, st
cl = Array("G", "H", "I", "T", "Y") ' столбцы
For f = 0 To UBound(cl)
    For k = 2 To 104 Step 2 ' строки со второй по 104
        st = cl(f) & k
        If Sheets(1).Range(st).Value = "" Then
            If InputBox("не сохраню") <> "123" Then
                Cancel = True: Exit For
            Else
                Exit Sub
            End If
        End If
    Next k
    If Cancel = True Then Exit For
Next f
End Sub
[/vba]


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщение[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim f, k, сl, st
cl = Array("G", "H", "I", "T", "Y") ' столбцы
For f = 0 To UBound(cl)
    For k = 2 To 104 Step 2 ' строки со второй по 104
        st = cl(f) & k
        If Sheets(1).Range(st).Value = "" Then
            If InputBox("не сохраню") <> "123" Then
                Cancel = True: Exit For
            Else
                Exit Sub
            End If
        End If
    Next k
    If Cancel = True Then Exit For
Next f
End Sub
[/vba]

Автор - K-SerJC
Дата добавления - 07.05.2019 в 12:10
pentagon63 Дата: Вторник, 07.05.2019, 12:30 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
То, что надо! большое спасибо!


бееедаааа
 
Ответить
СообщениеТо, что надо! большое спасибо!

Автор - pentagon63
Дата добавления - 07.05.2019 в 12:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос на поиск незаполненных ячеек, доработка макроса (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!