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

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