ChatGPT не умеет писать макросы

Ты попался на кликбейт, олуу... ну нет, на самом деле не совсем.

Итак, все вы знаете (а если не знаете, то пора выбираться из вакуума в котором вы находитесь) про такую нейросеть как ChatGPT. Мне все никак не удавалось попробовать его поюзать в связи с некоторыми сложностями доступа, и вот вчера наконец повезло. Ну и естественно я начал проверять его знания VBA?

И как ни странно они неплохие, но запустить сразу без правок написанный нейронкой скрипт удавалось далеко не всегда.
То переменную не объявит:

Function GetRightBoundary(rng As Range) As Long
    Dim cols As Collection
    Set cols = New Collection

    For Each col In rng.Columns ' При этом он знает про Option Explicit.
        If WorksheetFunction.CountA(col) > 0 Then cols.Add col.Column
    Next col
    GetRightBoundary = WorksheetFunction.Max(cols)
End Function

То передает неверный тип данных в функцию (например в метод Max из WoksheetFunction в примере выше он передает объект Collection).

В итоге после нескольких часов игр, я таки решил поставить конкретную задачу и довести ее до конца. Результат выложил на GitHub. Если кому-то лень читать мою гениальную статью, можно просто посмотреть код там.

Мне в работе часто приходится работать с таблицами, диапазон которых заранее не известен (часто таблица смещена по вертикали, и при этом есть некая шапка над ней).

Я решил сгенерировать с помощью ChatGPT класс, которому нужно будет передавать некий диапазон (а точнее UsedRange), а он в свою очередь в этом диапазоне по определенному алгоритму будет искать таблицу и если найдет, то вернет уже ее диапазон.

Сначала пробуем попросить придумать алгоритм для нахождения таблицы:

В excel на листе есть таблица. Начало и конец ее не известны. Известно, что над таблицей могут быть лишние ячейки с параметрами таблицы и ее описанием. Ннужно написать vba функцию, которая будет принимать лист, на котором находится искомая таблица, а возвращать она будет диапазон этой таблицы (без лишней информации в виде параметров и описания).

Для решения этой задачи можно использовать методы Find или FindNext, чтобы найти первую ячейку с данными и последнюю ячейку с данными в таблице. Затем можно использовать метод Intersect, чтобы исключить любую информацию в заголовке таблицы. Если заголовок таблицы не найден, то будет возвращен весь диапазон.

Вот пример кода функции, которая решает эту задачу:

Function FindTableRange(sheet As Worksheet) As Range
    Dim firstCell As Range
    Dim lastCell As Range
    Dim tableRange As Range
    
    ' Ищем первую ячейку с данными в таблице
    Set firstCell = sheet.Cells.Find(What:="*", _
                                      After:=sheet.Cells(1, 1), _
                                      LookAt:=xlPart, _
                                      SearchOrder:=xlByRows, _
                                      SearchDirection:=xlNext, _
                                      MatchCase:=False)
                                      
    If Not firstCell Is Nothing Then
        ' Ищем последнюю ячейку с данными в таблице
        Set lastCell = sheet.Cells.Find(What:="*", _
                                         After:=sheet.Cells(1, 1), _
                                         LookAt:=xlPart, _
                                         SearchOrder:=xlByRows, _
                                         SearchDirection:=xlPrevious, _
                                         MatchCase:=False)
                                         
        ' Используем метод Intersect, чтобы найти диапазон таблицы без заголовка
        If Not Intersect(firstCell.EntireRow, sheet.UsedRange) Is Nothing And _
           Not Intersect(lastCell.EntireRow, sheet.UsedRange) Is Nothing Then
            Set tableRange = sheet.Range(firstCell, lastCell).Offset(1).Resize(lastCell.row - firstCell.row)
        Else
            Set tableRange = sheet.UsedRange
        End If
    Else
        Set tableRange = sheet.UsedRange
    End If
    
    Set FindTableRange = tableRange
End Function

Неплохо, но этот вариант не работает так как нужно.

К примеру в таком виде он вернет выделенный диапазон A3:S28, когда сама таблица находится в диапазоне C9:S28:

После нескольких безуспешных попыток, я решил помочь нейронке, и придумал следующий алгоритм:

Необходимо найти границы диапазона таблицы.
Для нахождения верхней границы, нужно перебрать все колонки переданного диапазона, найти в них номера первых непустых строк и поместить их в массив. Медиана номеров этих строк – верхняя граница таблицы.
Для нахождения нижней границы, нужно перебрать все колонки переданного диапазона, найти в них номера последних непустых строк и поместить их в массив. Максимум из номеров этих строк – нижняя граница таблицы.
Для нахождения левой границы, нужно перебрать все строки переданного диапазона, найти в них номера первых непустых колонок и поместить их в массив. Медиана номеров этих колонок – левая граница таблицы.
Для нахождения правой границы, нужно перебрать все строки переданного диапазона, найти в них номера последних непустых колонок и поместить их в массив. Максимум из номеров этих колонок – правая граница таблицы.

Для реализации этой задачи в VBA можно использовать следующий код:

Function FindTableRange(tableRange As Range) As Range

    Dim numRows As Long
    Dim numCols As Long
    Dim row As Long
    Dim col As Long
    Dim topRow As Long
    Dim bottomRow As Long
    Dim leftCol As Long
    Dim rightCol As Long
    Dim topRows() As Long
    Dim bottomRows() As Long
    Dim leftCols() As Long
    Dim rightCols() As Long
    
    numRows = tableRange.rows.Count
    numCols = tableRange.Columns.Count
    
    ReDim topRows(1 To numCols)
    ReDim bottomRows(1 To numCols)
    ReDim leftCols(1 To numRows)
    ReDim rightCols(1 To numRows)
    
    For col = 1 To numCols
        topRows(col) = tableRange.rows.Count
        bottomRows(col) = 1
        For row = 1 To numRows
            If Not IsEmpty(tableRange(row, col)) Then
                If row < topRows(col) Then topRows(col) = row
                If row > bottomRows(col) Then bottomRows(col) = row
                If leftCols(row) = 0 Then leftCols(row) = col
                rightCols(row) = col
            End If
        Next row
    Next col
    
    topRow = WorksheetFunction.Median(topRows)
    bottomRow = WorksheetFunction.Max(bottomRows)
    leftCol = WorksheetFunction.Median(leftCols)
    rightCol = WorksheetFunction.Max(rightCols)
    
    Set FindTableRange = Intersect(tableRange.Worksheet.Range(tableRange.Cells(topRow, leftCol), tableRange.Cells(bottomRow, rightCol)), tableRange.Worksheet.UsedRange)
    
End Function

Бинго! Функция выдает верный результат. Но мне этого мало. Я хочу класс, и рефакторинг, и чтоб по красоте.

Не без корректировок, конечно, но спустя минут 30-40 (возможно меньше/больше, не помню), я наконец получил приемлемый результат.
Далее я решил попросить сгенерировать тесты используя Rubberduck:

Хорошо, я могу помочь написать unit-тесты для этого класса с использованием Rubberduck.

Перед тем, как начать написание тестов, необходимо убедиться, что Rubberduck установлен и настроен в Visual Studio.

После этого можно приступить к написанию тестов. Ниже приведен пример тестового класса с несколькими тестами для функции FindTableRange:

Option Explicit
'@TestModule
'@Folder "Tests"
Private Assert As Object
@ModuleInitializee
Public Sub ModuleInitialize()
Set Assert = CreateObject("Rubberduck.AssertClass")
End Sub
@ModuleCleanupp
Public Sub ModuleCleanup()
Set Assert = Nothing
End Sub
@TestMethodd
Public Sub Test_FindTableRange_SimpleTable()
'Arrange
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C3")
'Act
Dim result As Range
Set result = FindTableRange(rng)

'Assert
Assert.AreEqual "A2:C3", result.Address

End Sub
@TestMethodd
Public Sub Test_FindTableRange_EmptyTable()
'Arrange
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C1")
'Act
Dim result As Range
Set result = FindTableRange(rng)

'Assert
Assert.IsNull result

End Sub
@TestMethodd
Public Sub Test_FindTableRange_TableWithEmptyRowsAndColumns()
'Arrange
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:D5")
rng.Cells(2, 2).ClearContents
rng.Cells(4, 3).ClearContents
'Act
Dim result As Range
Set result = FindTableRange(rng)

'Assert
Assert.AreEqual "B3:C4", result.Address

End Sub
@TestMethodd
Public Sub Test_FindTableRange_TableWithHeader()
'Arrange
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C4")
rng.Cells(1, 1).Value = "Header1"
rng.Cells(1, 2).Value = "Header2"
rng.Cells(1, 3).Value = "Header3"
'Act
Dim result As Range
Set result = FindTableRange(rng)

'Assert
Assert.AreEqual "A2:C4", result.Address

End Sub
@TestMethodd
Public Sub Test_FindTableRange_TableWithMultipleRanges()
'Arrange
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C3")
Dim rng2 As Range
Set rng2 = ThisWorkbook.Sheets("Sheet1").Range("D1:F3")
Dim multiRange As Range
Set multiRange = Union(rng, rng2)
'Act
Dim result As Range
Set result = FindTableRange(multiRange)

'Assert
Assert.AreEqual "A2:F3", result.Address

End Sub

Эти тесты проверяют различные случаи использования функции FindTableRange, включая простые таблицы, пустые таблицы, таблицы с пустыми строками и столбцами, таблицы с заголовками и таблицы с несколькими диапазонами.

Тесты можно запустить с помощью Rubberduck, выбрав класс тестов в окне "Unit Test Explorer" и нажав кнопку "Run".

Не без вопросиков, конечно, но немного подредактировав, можно получить адекватные тесты.
Ну и на последок я попросил сгенерировать документацию методов в стиле VB.Net:

Документация к методам класса:

Option Explicit

''' <summary>
''' Этот класс содержит методы для поиска диапазона таблицы на листе Excel.
''' </summary>

''' <summary>
''' Находит диапазон таблицы в заданном диапазоне Range.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти таблицу.</param>
''' <returns>Диапазон Range, представляющий таблицу.</returns>
''' <example>
''' Пример использования:
''' <code>
''' Dim tableRange As Range
''' Set tableRange = FindTableRange(Range("A1:F10"))
''' </code>
''' </example>
Public Function FindTableRange(ByVal rng As Range) As Range
    Dim top As Long, bottom As Long, left As Long, right As Long
    
    If WorksheetFunction.CountA(rng) = 0 Then
        Set FindTableRange = Nothing
        Exit Function
    End If
    
    top = FindBoundary(rng, False, xlNext)
    bottom = FindBoundary(rng, False, xlPrevious)
    left = FindBoundary(rng, True, xlNext)
    right = FindBoundary(rng, True, xlPrevious)
    
    If top > 0 And bottom > 0 And left > 0 And right > 0 Then
        Set FindTableRange = rng.Parent.Range(rng.Cells(top, left), rng.Cells(bottom, right))
    End If
End Function

''' <summary>
''' Находит границы таблицы в заданном диапазоне Range по заданному направлению.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границы таблицы.</param>
''' <param name="isRow">Указывает, ищутся ли границы строк.</param>
''' <param name="Direction">Направление поиска границ таблицы.</param>
''' <returns>Число, представляющее границу таблицы.</returns>
Private Function FindBoundary(ByVal rng As Range, ByVal isRow As Boolean, ByVal Direction As XlSearchDirection) As Long
    Dim Arr() As Long
    Arr = FindBoundaryArray(rng, isRow, Direction)
    
    If UBound(Arr) > 0 Then
        If isRow Then
            FindBoundary = WorksheetFunction.Median(Arr)
        Else
            FindBoundary = WorksheetFunction.Max(Arr)
        End If
    Else
        FindBoundary = 0
    End If
End Function

''' <summary>
''' Находит массив границ таблицы в заданном диапазоне Range по заданному направлению.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границы таблицы.</param>
''' <param name="isRow">Указывает, ищутся ли границы строк.</param>
''' <param name="Direction">Направление поиска границ таблицы.</param>
''' <returns>Массив чисел, представляющий границы таблицы.</returns>
Private Function FindBoundaryArray(ByVal rng As Range, ByVal isRow As Boolean, ByVal Direction As XlSearchDirection) As Variant
    Dim i As Long
    Dim Arr() As Long
    
    If WorksheetFunction.CountA(rng) = 0 Then
        FindBoundaryArray = 0
        Exit Function
    End If
    
    If isRow And Direction = xlNext Then
        ReDim Arr(1 To rng.rows.Count)
        For i = 1 To rng.rows.Count
            Arr(i) = FindLeftBoundary(rng, i)
        Next i
    ElseIf isRow And Direction = xlPrevious Then
        ReDim Arr(1 To rng.rows.Count)
        For i = 1 To rng.rows.Count
            Arr(i) = FindRightBoundary(rng, i)
        Next i
    ElseIf Not isRow And Direction = xlNext Then
        ReDim Arr(1 To rng.Columns.Count)
        For i = 1 To rng.Columns.Count
            Arr(i) = FindTopBoundary(rng, i)
        Next i
    ElseIf Not isRow And Direction = xlPrevious Then
        ReDim Arr(1 To rng.Columns.Count)
        For i = 1 To rng.Columns.Count
            Arr(i) = FindBottomBoundary(rng, i)
        Next i
    End If
    
    FindBoundaryArray = Arr
End Function

''' <summary>
''' Находит правую границу таблицы в заданной строке диапазона Range.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границу таблицы.</param>
''' <param name="rowIdx">Индекс строки, в которой нужно найти границу таблицы.</param>
''' <returns>Число, представляющее правую границу таблицы.</returns>
Private Function FindRightBoundary(ByVal rng As Range, ByVal rowIdx As Long) As Long
    Dim colIdx As Long
    For colIdx = rng.Columns.Count To 1 Step -1
        If Not IsEmpty(rng(rowIdx, colIdx)) Then
            FindRightBoundary = colIdx
            Exit Function
        End If
    Next colIdx
    FindRightBoundary = 0
End Function

''' <summary>
''' Находит нижнюю границу таблицы в заданном столбце диапазона Range.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границу таблицы.</param>
''' <param name="colIdx">Индекс столбца, в котором нужно найти границу таблицы.</param>
''' <returns>Число, представляющее нижнюю границу таблицы.</returns>
Private Function FindBottomBoundary(ByVal rng As Range, ByVal colIdx As Long) As Long
    Dim rowIdx As Long
    For rowIdx = rng.rows.Count To 1 Step -1
        If Not IsEmpty(rng(rowIdx, colIdx)) Then
            FindBottomBoundary = rowIdx
            Exit Function
        End If
    Next rowIdx
    FindBottomBoundary = 0
End Function

''' <summary>
''' Находит левую границу таблицы в заданной строке диапазона Range.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границу таблицы.</param>
''' <param name="rowIdx">Индекс строки, в которой нужно найти границу таблицы.</param>
''' <returns>Число, представляющее левую границу таблицы.</returns>
Private Function FindLeftBoundary(ByVal rng As Range, ByVal rowIdx As Long) As Long
    Dim colIdx As Long
    For colIdx = 1 To rng.Columns.Count Step 1
        If Not IsEmpty(rng(rowIdx, colIdx)) Then
            FindLeftBoundary = colIdx
            Exit Function
        End If
    Next colIdx
    FindLeftBoundary = 0
End Function

''' <summary>
''' Находит верхнюю границу таблицы в заданном столбце диапазона Range.
''' </summary>
''' <param name="rng">Диапазон Range, в котором нужно найти границу таблицы.</param>
''' <param name="colIdx">Индекс столбца, в котором нужно найти границу таблицы.</param>
''' <returns>Число, представляющее верхнюю границу таблицы.</returns>
Private Function FindTopBoundary(ByVal rng As Range, ByVal colIdx As Long) As Long
    Dim rowIdx As Long
    For rowIdx = 1 To rng.rows.Count Step 1
        If Not IsEmpty(rng(rowIdx, colIdx)) Then
            FindTopBoundary = rowIdx
            Exit Function
        End If
    Next rowIdx
    FindTopBoundary = 0
End Function

Написание документации мы обсуждали с подписчиками в моем телеграм канале (_не подписывайтесь).