VBA - добавить данные в таблицу с наименьшим количеством строк (15 ТАБЛИЦ)

Question

Я хочу добавить имя и положение NewJoiner в таблицу с наименьшим количеством строк.Также я бы хотел, чтобы VBA вернул мне имя таблицы, в которую оно было добавлено.

Таким образом, код будет подсчитывать, в конечном счете, подсчитывать каждую строку из 15 таблиц и добавлять имя и позицию в таблицу с наименьшим количествомстрок и возвращают номер или имя таблицы с помощью функции MsgBox.

Извините, если это глупый вопрос, я буквально запустил VBA 2 дня назад и многому научился в этом сообществе.

Вот мой код:

Sub ssNewJoinerM()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet


Set ws1 = ActiveSheet
Set ws2 = ActiveSheet
Set ws3 = ActiveSheet
Set ws4 = ActiveSheet
Set ws5 = ActiveSheet
Set ws6 = ActiveSheet
Set ws7 = ActiveSheet
Set ws8 = ActiveSheet

Set ws1 = ThisWorkbook.Sheets("Monthly Movements")
Set ws2 = ThisWorkbook.Sheets("Howard-Marle Hub")
Set ws3 = ThisWorkbook.Sheets("Bernard Hub")
Set ws4 = ThisWorkbook.Sheets("Thomas Hub")
Set ws5 = ThisWorkbook.Sheets("Michael Hub")
Set ws6 = ThisWorkbook.Sheets("Oliver Hub")
Set ws7 = ThisWorkbook.Sheets("Lance Hub")
Set ws8 = ThisWorkbook.Sheets("John Hub")

Dim table1 As ListObject
Dim table2 As ListObject
Dim table3 As ListObject
Dim table4 As ListObject
Dim table5 As ListObject
Dim table6 As ListObject
Dim table7 As ListObject
Dim table8 As ListObject
Dim table9 As ListObject
Dim table10 As ListObject
Dim table11 As ListObject
Dim table12 As ListObject
Dim table13 As ListObject
Dim table14 As ListObject
Dim table15 As ListObject

Set table1 = ws2.ListObjects("Table1")
Set table2 = ws2.ListObjects("Table2")
Set table3 = ws1.ListObjects("Table3")
Set table4 = ws3.ListObjects("Table4")
Set table5 = ws3.ListObjects("Table5")
Set table6 = ws4.ListObjects("Table6")
Set table7 = ws4.ListObjects("Table7")
Set table8 = ws5.ListObjects("Table8")
Set table9 = ws5.ListObjects("Table9")
Set table10 = ws6.ListObjects("Table10")
Set table11 = ws6.ListObjects("Table11")
Set table12 = ws7.ListObjects("Table12")
Set table13 = ws7.ListObjects("Table13")
Set table14 = ws8.ListObjects("Table14")
Set table15 = ws8.ListObjects("Table15")


 Dim NewJoiner As String
 NewJoiner = InputBox("Enter new joiner name in the following format (Surname, First Name)", "Adding New Joiner to Hub")
 Dim Position As String
 Position = InputBox("Enter new joiner Position (A, C, SC, PC, MP, Partner, Admin, Analyst, Director)", "Assigning New Joiner to a position")
 'Input Name and Position and stores it (Could be improved with user form...)

Answer 1

Следующие действия будут примерно такими же, как у @FunThomas, он просто побил меня этим, но я все равно решил опубликовать его, так как он не использует функцию, а также показывает, как пропустить определенные таблицы:

Sub FindSmallestTable()
Dim tbl As ListObject
Dim sht As Worksheet

'Loop through each sheet and table in the workbook
For Each sht In ThisWorkbook.Worksheets
    For Each tbl In sht.ListObjects 'loop through all tables
        'To omit certain tables you can do the below
        If tbl.Name <> "Table1" And tbl.Name <> "Table2" Then
            If MyTable Is Nothing Then
                Set MyTable = tbl 'set the table if not previously set
                Set MyWorksheet = sht 'set the worksheet if not previously set
            ElseIf tbl.ListRows.Count < MyTable.ListRows.Count Then 'if table rows is smaller than previously set one, reset
                Set MyTable = tbl
                Set MyWorksheet = sht
            End If
        End If
    Next tbl
Next sht
MsgBox "The Worksheet: " & MyWorksheet.Name & vbNewLine & "The Table: " & MyTable.Name, vbInformation, "Smallest Table in Workbook"
End Sub

Answer 2

Следующая функция перебирает все таблицы всех листов в рабочей книге.Возвращает таблицу с наименьшим количеством строк.Чтобы проверить количество строк в таблице, вы можете получить доступ к свойству Range этой таблицы и использовать Rows.Count этого диапазона.

Function findShortestTable(wb As Workbook) As ListObject
    Dim ws As Worksheet, table As ListObject, shortestTable As ListObject

    For Each ws In wb.Worksheets
        For Each table In ws.ListObjects
            If shortestTable Is Nothing Then
                Set shortestTable = table
            ElseIf table.Range.Rows.Count < shortestTable.Range.Rows.Count Then
                Set shortestTable = table
            End If
        Next table
    Next ws

    Set findShortestTable = shortestTable
End Function

Вы можете назвать его, например, так:

Dim table As ListObject
Set table = findShortestTable(ThisWorkbook)
MsgBox table.Name