Vba excel найти непустую ячейку

Елена_88

1

Поиск непустой ячейки в столбце

11.02.2009, 07:42. Показов 19692. Ответов 6


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

Приветствую !
Понимаю, задачка смешная, но мне, как новичку очень нужна помощь
Нужно написать функцию, которая будет возвращать значение первой непустой ячейки сверху.
т.е., например, стоим на А10, первая заполненная у нас А3, так как вытащить ее значение ?

Добавлено через 20 минут 39 секунд
Можно ли потом найти вторую заполненную ячейку ?

Sasha_Smirnov

5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

12.02.2009, 01:31

2

Вот из этой простенькой «сабрутины» я и предлагаю сваять нужную Вам функцию. Отзовитесь, ау!

Visual Basic
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

Вот тут действительно функция! Функциональность её та же.
Что делает основная программа (Sub), ясно из её названия.

Visual Basic
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

Это более-менее работоспособный вариант.

Классики Си! Видите, сколько мороки на бэйсике? Где ж ваше веское слово… Ну хотя бы просто в поиске первой ячейки, с содержимым.



0



Супер-модератор

8782 / 2533 / 144

Регистрация: 07.03.2007

Сообщений: 11,873

15.02.2009, 05:11

3

а если перед поиском сделать фильтр. так ты найдешь адрес первой непустой ячейки. потом фильтр можно снять



0



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

15.02.2009, 15:49

4

Я и без фильтра нашёл: по контрол-F в Excel.

И вообще, это Елена ищет. А форум что-то молчит, хоть и просмотров под полторы сотни.



0



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

18.02.2009, 20:23

5

Я и без фильтра нашёл: по контрол-F в Excel.

А форум всё молчит, хоть и просмотров за две сотни.



0



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

05.03.2009, 16:26

6

Вот черновой вариант. Повторяю, поскольку на прежних сломалась кнопка запуска.



0



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

05.03.2009, 16:51

7

Или, скорее, так: назначенная макросу кнопка, при архивировании, теряет связь с макросом.

Поэтому-то и прошу — поискать непустые ячейки на Си, ассемблере и пр.

Не будешь же (в жизни) каждый раз объяснять пользователю, мол, жми альт-F8, щёлкай по имени, жми кнопку Выполнить, — нудно!



0



замечания

Найдите последнюю непустую ячейку в столбце

В этом примере мы рассмотрим метод возврата последней непустой строки в столбец для набора данных.

Этот метод будет работать независимо от пустых областей в наборе данных.

Однако следует соблюдать осторожность, если задействованы объединенные ячейки , поскольку метод End будет «остановлен» против объединенной области, возвращая первую ячейку объединенной области.

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

Sub FindingLastRow()
    Dim wS As Worksheet, LastRow As Long
    Set wS = ThisWorkbook.Worksheets("Sheet1")
    
    'Here we look in Column A
    LastRow = wS.Cells(wS.Rows.Count, "A").End(xlUp).Row
    Debug.Print LastRow
End Sub

Чтобы устранить указанные выше ограничения, строка:
LastRow = wS.Cells(wS.Rows.Count, "A").End(xlUp).Row

могут быть заменены на:

  1. для последнего использованного ряда "Sheet1" :
    LastRow = wS.UsedRange.Row - 1 + wS.UsedRange.Rows.Count .

  2. для последней непустой ячейки столбца "A" в "Sheet1" :

     Dim i As Long
     For i = LastRow To 1 Step -1
         If Not (IsEmpty(Cells(i, 1))) Then Exit For
     Next i
     LastRow = i
    

Найти последнюю строку с использованием именованного диапазона

Если у вас есть Именованный диапазон в вашем листе, и вы хотите динамически получить последнюю строку этого динамического именованного диапазона. Также охватывает случаи, когда Named Range не начинается с первой строки.

Sub FindingLastRow()
    
Dim sht As Worksheet
Dim LastRow As Long
Dim FirstRow As Long

Set sht = ThisWorkbook.Worksheets("form")

'Using Named Range "MyNameRange"
FirstRow = sht.Range("MyNameRange").Row

' in case "MyNameRange" doesn't start at Row 1
LastRow = sht.Range("MyNameRange").Rows.count + FirstRow - 1

End Sub

Обновить:
Потенциальная лазейка была отмечена @Jeeped для aa named range с несмежными строками, поскольку она генерирует неожиданный результат. Чтобы решить эту проблему, код пересматривается, как показано ниже.
Апппции: таргеты sheet = form , named range = MyNameRange

Sub FindingLastRow()
    Dim rw As Range, rwMax As Long
    For Each rw In Sheets("form").Range("MyNameRange").Rows
        If rw.Row > rwMax Then rwMax = rw.Row
    Next
    MsgBox "Last row of 'MyNameRange' under Sheets 'form': " & rwMax
End Sub

Получить строку последней ячейки в диапазоне

'if only one area (not multiple areas):
With Range("A3:D20")
    Debug.Print .Cells(.Cells.CountLarge).Row
    Debug.Print .Item(.Cells.CountLarge).Row 'using .item is also possible
End With 'Debug prints: 20

'with multiple areas (also works if only one area):
Dim rngArea As Range, LastRow As Long
With Range("A3:D20, E5:I50, H20:R35")
    For Each rngArea In .Areas
        If rngArea(rngArea.Cells.CountLarge).Row > LastRow Then 
            LastRow = rngArea(rngArea.Cells.CountLarge).Row
        End If
    Next
    Debug.Print LastRow 'Debug prints: 50
End With

Найти последнюю непустую колонку в рабочем листе

Private Sub Get_Last_Used_Row_Index()
    Dim wS As Worksheet
    
    Set wS = ThisWorkbook.Sheets("Sheet1")
    Debug.Print LastCol_1(wS)
    Debug.Print LastCol_0(wS)
End Sub

Вы можете выбрать один из двух вариантов, если хотите узнать, нет ли данных на листе:

  • НЕТ: Используйте LastCol_1: вы можете использовать его непосредственно в wS.Cells(...,LastCol_1(wS))
  • ДА: Использовать LastCol_0: вам нужно проверить, если результат, полученный вами от функции, равен 0 или нет, прежде чем использовать его
Public Function LastCol_1(wS As Worksheet) As Double
    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastCol_1 = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Column
        Else
            LastCol_1 = 1
        End If
    End With
End Function

Свойства объекта Err автоматически сбрасываются до нуля после выхода функции.

Public Function LastCol_0(wS As Worksheet) As Double
    On Error Resume Next
    LastCol_0 = wS.Cells.Find(What:="*", _
                            After:=ws.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
End Function

Последняя ячейка в Range.CurrentRegion

Range.CurrentRegion — прямоугольная область диапазона, окруженная пустыми ячейками. Пустые ячейки с такими формулами, как ="" или ' , не считаются пустыми (даже ISBLANK Excel).

Dim rng As Range, lastCell As Range
Set rng = Range("C3").CurrentRegion       ' or Set rng = Sheet1.UsedRange.CurrentRegion
Set lastCell = rng(rng.Rows.Count, rng.Columns.Count)

Найти последнюю непустую строку в рабочем листе

Private Sub Get_Last_Used_Row_Index()
    Dim wS As Worksheet
    
    Set wS = ThisWorkbook.Sheets("Sheet1")
    Debug.Print LastRow_1(wS)
    Debug.Print LastRow_0(wS)
End Sub

Вы можете выбрать один из двух вариантов, если хотите узнать, нет ли данных на листе:

  • НЕТ: Используйте LastRow_1: вы можете использовать его непосредственно в wS.Cells(LastRow_1(wS),...)
  • YES: Использовать LastRow_0: вам нужно проверить, есть ли результат, полученный вами от функции, 0 или нет, прежде чем использовать его
Public Function LastRow_1(wS As Worksheet) As Double
    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow_1 = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        Else
            LastRow_1 = 1
        End If
    End With
End Function

Public Function LastRow_0(wS As Worksheet) As Double
    On Error Resume Next
    LastRow_0 = wS.Cells.Find(What:="*", _
                            After:=ws.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
End Function

Найти последнюю непустую ячейку в строке

В этом примере мы рассмотрим метод возврата последнего непустого столбца в строке.

Этот метод будет работать независимо от пустых областей в наборе данных.

Однако следует соблюдать осторожность, если задействованы объединенные ячейки , поскольку метод End будет «остановлен» против объединенной области, возвращая первую ячейку объединенной области.

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

Sub FindingLastCol()
    Dim wS As Worksheet, LastCol As Long
    Set wS = ThisWorkbook.Worksheets("Sheet1")
    
    'Here we look in Row 1
    LastCol = wS.Cells(1, wS.Columns.Count).End(xlToLeft).Column
    Debug.Print LastCol
End Sub

Найти последнюю непустую ячейку в рабочем листе — Производительность (массив)

  • Первая функция, использующая массив, намного быстрее
  • Если .ThisWorkbook.ActiveSheet без необязательного параметра, по умолчанию будет .ThisWorkbook.ActiveSheet
  • Если диапазон пуст, он будет возвращать Cell( 1, 1 ) по умолчанию вместо Nothing

Скорость:

GetMaxCell (Array): Duration: 0.0000790063 seconds
GetMaxCell (Find ): Duration: 0.0002903480 seconds

. Измеряется с помощью MicroTimer


Public Function GetLastCell(Optional ByVal ws As Worksheet = Nothing) As Range
    Dim uRng As Range, uArr As Variant, r As Long, c As Long
    Dim ubR As Long, ubC As Long, lRow As Long

    If ws Is Nothing Then Set ws = Application.ThisWorkbook.ActiveSheet
    Set uRng = ws.UsedRange
    uArr = uRng
    If IsEmpty(uArr) Then
        Set GetLastCell = ws.Cells(1, 1):   Exit Function
    End If
    If Not IsArray(uArr) Then
        Set GetLastCell = ws.Cells(uRng.Row, uRng.Column):  Exit Function
    End If
    ubR = UBound(uArr, 1):  ubC = UBound(uArr, 2)
    For r = ubR To 1 Step -1    '----------------------------------------------- last row
        For c = ubC To 1 Step -1
            If Not IsError(uArr(r, c)) Then
                If Len(Trim$(uArr(r, c))) > 0 Then
                    lRow = r:   Exit For
                End If
            End If
        Next
        If lRow > 0 Then Exit For
    Next
    If lRow = 0 Then lRow = ubR
    For c = ubC To 1 Step -1    '----------------------------------------------- last col
        For r = lRow To 1 Step -1
            If Not IsError(uArr(r, c)) Then
                If Len(Trim$(uArr(r, c))) > 0 Then
                    Set GetLastCell = ws.Cells(lRow + uRng.Row - 1, c + uRng.Column - 1)
                    Exit Function
                End If
            End If
        Next
    Next
End Function

'Returns last cell (max row & max col) using Find

Public Function GetMaxCell2(Optional ByRef rng As Range = Nothing) As Range 'Using Find

    Const NONEMPTY As String = "*"

    Dim lRow As Range, lCol As Range

    If rng Is Nothing Then Set rng = Application.ThisWorkbook.ActiveSheet.UsedRange

    If WorksheetFunction.CountA(rng) = 0 Then
        Set GetMaxCell2 = rng.Parent.Cells(1, 1)
    Else
        With rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                        After:=.Cells(1, 1), _
                                        SearchDirection:=xlPrevious, _
                                        SearchOrder:=xlByRows)
            If Not lRow Is Nothing Then
                Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                            After:=.Cells(1, 1), _
                                            SearchDirection:=xlPrevious, _
                                            SearchOrder:=xlByColumns)

                Set GetMaxCell2 = .Parent.Cells(lRow.Row, lCol.Column)
            End If
        End With
    End If
End Function

,

MicroTimer :

Private Declare PtrSafe Function getFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Function MicroTimer() As Double
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency        'Get frequency
    getTickCount cyTicks1                                   'Get ticks
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency 'Returns Seconds
End Function

Свойство End объекта Range применяется для поиска первых и последних заполненных ячеек в VBA Excel — аналог сочетания клавиш Ctrl+стрелка.

Свойство End объекта Range возвращает объект Range, представляющий ячейку в конце или начале заполненной значениями области исходного диапазона по строке или столбцу в зависимости от указанного направления. Является в VBA Excel программным аналогом сочетания клавиш — Ctrl+стрелка (вверх, вниз, вправо, влево).

Возвращаемая свойством Range.End ячейка в зависимости от расположения и содержания исходной:

Исходная ячейка Возвращаемая ячейка
Исходная ячейка пустая Первая заполненная ячейка или, если в указанном направлении заполненных ячеек нет, последняя ячейка строки или столбца в заданном направлении.
Исходная ячейка не пустая и не крайняя внутри исходного заполненного диапазона в указанном направлении Последняя заполненная ячейка исходного заполненного диапазона в указанном направлении
Исходная ячейка не пустая, но в указанном направлении является крайней внутри исходного заполненного диапазона Первая заполненная ячейка следующего заполненного диапазона или, если в указанном направлении заполненных ячеек нет, последняя ячейка строки или столбца в заданном направлении.

Синтаксис

Expression.End (Direction)

Expression — выражение (переменная), представляющее объект Range.

Параметры

Параметр Описание
Direction Константа из коллекции XlDirection, задающая направление перемещения. Обязательный параметр.

Константы XlDirection:

Константа Значение Направление
xlDown -4121 Вниз
xlToLeft -4159 Влево
xlToRight -4161 Вправо
xlUp -4162 Вверх

Примеры

Скриншот области рабочего листа для визуализации примеров применения свойства Range.End:

Примеры возвращаемых ячеек свойством End объекта Range("C10") с разными значениями параметра Direction:

Выражение с Range.End Возвращенная ячейка
Set myRange = Range("C10").End(xlDown) Range("C16")
Set myRange = Range("C10").End(xlToLeft) Range("A10")
Set myRange = Range("C10").End(xlToRight) Range("E10")
Set myRange = Range("C10").End(xlUp) Range("C4")

Пример возвращения заполненной значениями части столбца:

Sub Primer()

Dim myRange As Range

Set myRange = Range(Range(«C10»), Range(«C10»).End(xlDown))

MsgBox myRange.Address  ‘Результат: $C$10:$C$16

End Sub


Like this post? Please share to your friends:
  • Vba excel объединить таблицы
  • Vba excel найти минимальное значение
  • Vba excel объединить несколько excel файлов в один
  • Vba excel найти значение в таблице
  • Vba excel объединить в столбец