Как найти непустые ячейки в excel vba

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Sub FindAndCountEmptyCells(): Static k As Long 'если файл не пуст, то +1 при каждом вызове
 
 
If k = 0 Then  'а это так: 1) при первом вызове данной функции; 2) ещё не придумал
 
    Range("a1").Activate                            'проверка ячейки A1
    If Not IsEmpty(ActiveCell) Then k = k + 1       'если в A1 не пусто, то счёт ведётся с неё
    k = k + 1
    Application.FindFormat.NumberFormat = "General" 'аналог нажатия <Ctrl>+<F> (формат "Общий")
    
    'Активация k-й непустой ячейки.
    Cells.Find(What:="*", SearchFormat:=True, SearchOrder:=xlByColumns).Activate
 
Else
 
    Cells.FindNext(After:=ActiveCell).Activate 'при повторных вызовах - поиск следующей непустой
    k = k + 1
    If ActiveCell.Column & ":" & ActiveCell.Row = "1:1" Then k = 1 'это когда прошли всю таблицу
End If
 
 
MsgBox "Это " & k & "-я непустая ячейка (" & ActiveCell.Column & ":" & ActiveCell.Row & ")."
'здесь вместо этого мэссиджа Вы можете присваивать функции значение выделенной (активной) ячейки
 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

Function FindAndCountNotEmptyCells()
'функция ищет на листе Excel k-ю (при k-м вызове) непустую ячейку (по столбцам)
  
Static firstfoundRow As Long, firstfoundCol As Long 'координаты первой найденной непустой ячейки
Static k As Long 'если файл не пуст, то при каждом вызове возвращает № очередной непустой ячейки
     
 
If k = 0 Then  'а это так при первом вызове функции и при возврате по GoTo (когда всё обыскано)
        Cells.Find(What:="*", SearchOrder:=xlByColumns).Activate 'Активация 1-й непустой ячейки.
          
        If Not IsEmpty(Cells(1, 1)) Then 'если в A1 не пусто, то при 1-м вызове считаем с неё
            firstfoundRow = 1: firstfoundCol = 1    'Запомнили координаты 1-й ячейки: (1, 1) -
            Cells.FindPrevious(After:=ActiveCell).Activate                  'и вернулись в неё.
        Else
            firstfoundRow = ActiveCell.Row: firstfoundCol = ActiveCell.Column
        End If
Else
    Cells.FindNext(After:=ActiveCell).Activate 'поиск следующей ячейки при повторных вызовах
End If
 
 
If (ActiveCell.Column = firstfoundCol) And (ActiveCell.Row = firstfoundRow) And (k > 1) Then
    k = 0       'сброс k; функция обошла ("просканировала") все ячейки активного листа
    FindAndCountNotEmptyCells = "I HAVE RETIRED)"
    Exit Function                                   'завершение работы функции: она всё обыскала
End If
  
 
FindAndCountNotEmptyCells = ActiveCell 'функция принимает значение очередной непустой ячейки
  
k = k + 1
 
MsgBox k & "-я непустая ячейка листа """ & ActiveSheet.Name & """ содержит: " & ActiveCell _
& vbCr & "(формат этого значения - """ & ActiveCell.NumberFormat & """)"
End Function
  
  
  
Sub I_seek_for_the_2_first_negative_cells_in_ActiveSheet()
  
Dim the1StNegativeCell, the2NdNegativeCell '1-е и 2-е отриц. числа (если есть) или что найдётся
  
Do
    the1StNegativeCell = FindAndCountNotEmptyCells
    If IsNumeric(the1StNegativeCell) And the1StNegativeCell < 0 Then Exit Do
Loop Until the1StNegativeCell = "I HAVE RETIRED)"
'выходим из цикла, как только находим в таблице ПЕРВОЕ отрицательное число, или когда его там нет
  
 
If the1StNegativeCell <> "I HAVE RETIRED)" Then 'то есть 1-е отриц. число всё же найдено
''''''''' продолжаем вызывать функцию поиска ''''''''''''''
    Do
    the2NdNegativeCell = FindAndCountNotEmptyCells
    If IsNumeric(the2NdNegativeCell) And the2NdNegativeCell < 0 Then Exit Do
    Loop Until the2NdNegativeCell = "I HAVE RETIRED)"
    'выходим из цикла, как только находим в таблице ВТОРОЕ отриц. число, или когда его там нет
    
    If the2NdNegativeCell = "I HAVE RETIRED)" Then _
        the2NdNegativeCell = "Второго отрицательного числа у вас в таблице (пока) нет."
Else
    MsgBox "На рабочем листе """ & ActiveSheet.Name & """ вашей таблицы отрицательных чисел нет."
    Exit Sub
End If
  
 
MsgBox "the1StNegativeCell = " & the1StNegativeCell 'сообщение, чему = 1-е отриц. число (в столбце)
MsgBox "the2NdNegativeCell = " & the2NdNegativeCell 'сообщение, чему = 2-е отриц. число (следующее)
End Sub