Ты попался на кликбейт, олуу... ну нет, на самом деле не совсем.
Итак, все вы знаете (а если не знаете, то пора выбираться из вакуума в котором вы находитесь) про такую нейросеть как 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
Написание документации мы обсуждали с подписчиками в моем телеграм канале (не подписывайтесь).
