ChatGPT can’t write macros

You got clickbait, lol… Well, no, not really.

So, all of you know (and if you don’t know, then it’s time to get out of the vacuum in which you are) about such a neural network as ChatGPT. I still could not try to use it due to some access difficulties, and yesterday I finally got lucky. And of course, I started testing his knowledge of VBA😌

And oddly enough, they are not bad, but it was far from always possible to launch the script written by the neuron immediately without editing.
That variable will not be declared:

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

That passes the wrong data type to a function (for example, to a method Max from WoksheetFunction in the example above it passes an object Collection).

Finally, after a few hours games, I decided to set a specific task and bring it to the end. Posted the result on GitHub. If someone is too lazy to read my brilliant article, you can just look at the code there.

In my work, I often have to work with tables whose range is not known in advance (often the table is shifted vertically, and at the same time there is a certain cap above it).

I decided to generate a class using ChatGPT, which will need to pass a certain range (or rather UsedRange), and it, in turn, will search for a table in this range according to a certain algorithm and if it finds it, it will return its range.

First, we try to ask to come up with an algorithm for finding the table:

There is a table in excel. Its beginning and end are not known. It is known that above the table there may be extra cells with table parameters and its description. You need to write a vba function that will accept the sheet on which the required table is located, and it will return the range of this table (without unnecessary information in the form of parameters and descriptions).

Для решения этой задачи можно использовать методы 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

Not bad, but this option does not work as it should.

For example, in this form, it will return the selected range A3:S28when the table itself is in range C9:S28:

After several unsuccessful attempts, I decided to help the neuron, and came up with the following algorithm:

You need to find the range limits of the table.
For finding top borders, you need to go through all the columns of the transferred range, find the numbers in them first non-empty strings and put them in an array. The median of the numbers of these rows is the upper bound of the table.
For finding bottom borders, you need to go through all the columns of the transferred range, find the numbers in them recent non-empty strings and put them in an array. The maximum number of these rows is the lower border of the table.
For finding left borders, you need to go through all the lines of the passed range, find the numbers in them first non-empty columns and put them in an array. The median of the numbers of these columns is the left border of the table.
For finding right borders, you need to go through all the lines of the passed range, find the numbers in them recent non-empty columns and put them in an array. The maximum number of these columns is the right border of the table.

Для реализации этой задачи в 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

Bingo! The function returns the correct result. But this is not enough for me. I want a class, and refactoring, and beauty.

Not without adjustments, of course, but after 30-40 minutes (maybe less / more, I don’t remember), I finally got an acceptable result.
Next, I decided to ask to generate tests using 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".

Not without questions, of course, but with a little editing, you can get adequate tests.
And finally, I asked to generate documentation of methods in the VB.Net style:

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

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

We discussed writing documentation with subscribers in my telegram channel (Not subscribe).

Similar Posts

Leave a Reply

Your email address will not be published. Required fields are marked *