Ошибка выполнения 9 при отправке новых элементов массива
У меня есть книга с описательными пронумерованными именами листов. Мне нужно заполнить массив числами, которые я извлекаю из имен листов. Я получаю ошибку времени выполнения 9, индекс которой выходит за пределы допустимого диапазона, когда я пытаюсь добавить новые элементы массива. В книге всего 111 листов, поэтому я не собираюсь переполнять массив. Я пробовал объявить Dim haystack (1 To 111), но это не сработало.
Dim num As Integer
Dim newEntry As String
Dim haystack() As String
Dim wsCount As Integer
wsCount = ActiveWorkbook.Worksheets.Count
For num = 1 To wsCount
newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
If IsNumeric(newEntry) Then
haystack(num) = newEntry 'this line throws an error
End If
Next num
Декларация понадобится один раз. Редактируйте только (1 To 111) в третьей строке кода.
Этот учебный ресурс может оказаться вам полезным excelmacromastery.com/excel-vba-array
Ответы 3
Попробуйте этот код:
Sub Test()
Dim num As Integer
Dim newEntry As String
Dim haystack As Variant
Dim wsCount As Integer
wsCount = ActiveWorkbook.Worksheets.Count
For num = 1 To wsCount
newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
If IsNumeric(newEntry) Then
If IsEmpty(haystack) Then
ReDim haystack(0)
Else
ReDim Preserve haystack(UBound(haystack) + 1)
End If
haystack(num - 1) = newEntry
End If
Next num
End Sub
Я стараюсь избегать redim preserve из-за накладных расходов.
Также обратите внимание, что я использую ThisWorkbook вместо ActiveWorkbook, чтобы не запутать макрос, если у вас открыто более одной книги.
Я предлагаю:
Option Explicit
Sub marine()
Dim num As Integer
Dim newEntry As String
Dim haystack() As String
ReDim haystack(1 To ThisWorkbook.Worksheets.Count)
For num = 1 To UBound(haystack)
newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
If IsNumeric(newEntry) Then
haystack(num) = newEntry
End If
Next num
End Sub
Если вы не против, чтобы haystack был введен как вариант (содержимое по-прежнему будет строкой), но вы не хотите иметь пустые записи, вы можете использовать объект ArrayList, который имеет простой метод копирования в массив вариантов. .
Вы также можете использовать объект Collection или Dictionary, но код будет немного длиннее.
Sub merge()
Dim ws As Worksheet
Dim newEntry As String
Dim haystack() As Variant
Dim arrHaystack As Object
Set arrHaystack = CreateObject("System.Collections.ArrayList")
For Each ws In ThisWorkbook.Worksheets
With ws
newEntry = Mid(.Name, InStr(.Name, "(") + 1, InStr(.Name, ")") - InStr(.Name, "(") - 1)
End With
If IsNumeric(newEntry) Then
arrHaystack.Add newEntry
End If
Next ws
haystack = arrHaystack.toarray
End Sub
См. VBA ArrayList — Полное руководство для получения более подробной информации об этом методе.
Рон Розенфельд: в любом случае все равно получаю ту же ошибку. Но мне очень нравятся ваши подимена, собираюсь начать называть свои sub sume() и sub ject().
@andreithegiant Я удивлен. Здесь нет ошибок. Интересно, что происходит? Какая строка возвращает ошибку?
извините, ваш код должен работать, но моя первоначальная ошибка, умело исправленная обработкой ошибок FaneDuru, заключалась в том, что не все имена вкладок содержали круглые скобки. Это вызвало ошибку. Спасибо за вашу помощь и извините, что отправил вас в погоню за дураками.
Пожалуйста, попробуйте этот способ. Он использует вторую переменную (k), чтобы избежать пустых элементов массива:
Sub fillSheetsName()
Dim num As Long, newEntry As String, haystack() As String, wsCount As Integer, k As Long, arr
wsCount = ActiveWorkbook.Worksheets.count
ReDim haystack(1 To wsCount): k = 1
For num = 1 To wsCount
If InStr(Worksheets(num).name, "(") > 0 And InStr(Worksheets(num).name, "(") > 0 Then _
newEntry = Split(Split(Worksheets(num).name, "(")(1), ")")(0) 'it extracts what is between parenthesis
If IsNumeric(newEntry) Then
haystack(k) = newEntry: k = k + 1 'to not have empty elements (for cases where newEntry is not numeric)
newEntry = ""
End If
Next num
ReDim Preserve haystack(1 To k - 1)
Debug.Print UBound(haystack) 'how many such numbers have been extracted
Debug.Print Join(haystack, vbCrLf) 'see in Immediate Window the array content
End Sub
Спасибо, это исправлено. Проблема заключалась в отсутствии проверки ошибок: мне не удалось проверить наличие скобок, и они были не во всех именах листов. Однако в этом коде в случаях, когда newEntry не является числовым, он заполняет массив последней числовой записью, поэтому возникает несколько коллизий. Ничего страшного, я разберусь. Еще раз спасибо, что сэкономили мне часы отладки.
@andreithegiant Не уверен, что я правильно понимаю, что означает «для случаев, когда newEntry не хотел числового значения, он заполнил массив последней числовой записью». Возвращает ли он числовую часть строки в скобках? Что должны означать «столкновения» в контексте кода? Нужны ли вам уникальные значения и возвращаются ли все случаи, даже если существует дубликат? Можете ли вы привести пример? Я уверен, что это можно решить в коде. Конечно, если я понимаю, о чем речь...
есть вкладки с названием «Счет» (1), . . ., Invoice(76), за которым следуют 3 буквенных названия вкладок Fu, Bar и т. д. Когда будет завершена последняя числовая вкладка, Invoice(76), он заполнит массив значением 76 3x (т. е. k увеличивается, а предыдущее значение равно дублируется (т.е. столкновение)).
@andreithegiant Я не думаю, что процесс происходит, когда вы пытаетесь его описать... Скорее всего, для одного и того же числового значения есть больше случаев. Я имею в виду «Счет-фактура (76)», «Что-то (76)» и «Тест (76)». Если вы хотите, чтобы код пропустил следующие коды, я имею в виду, чтобы не допускать дубликатов, я могу адаптировать его для этого. Если вы хотите/попробуете объяснить другую проблему, приведите красноречивый пример. Я не слишком много понимаю из того, что вы пытались проиллюстрировать... Это было основано на вашем предположении, которое, боюсь, неверно.
Вкладок всего 111, поэтому легко убедиться в отсутствии вкладок с повторяющимися числовыми значениями. Однако эти 3 альфа-вкладки не содержат круглых скобок (т. е. Fu, Bar вместо Invoice(i)), поэтому они не входят в первое условие If в цикле for. Но похоже, что он вводит второй if и переносит последнее значение для newEntry. Я попробую вложить второе If в первое и посмотреть, не исправит ли это.
@andreithegiant Да, я посмотрел код, и ты прав! Мне не удалось повторно инициализировать переменную newEntry... Пожалуйста, протестируйте обновленный ответ и отправьте отзыв.
Там я вложил второе If, и теперь оно работает правильно! Спасибо за помощь!
Не нужно ничего вкладывать. Секунда хотя бы замедляет скорость кода, после упомянутого обновления...
В зависимости от того, используете ли вы массивы с индексом 0 или 1, вы можете использовать
Dim haystack(110)илиDim haystack(111)В качестве альтернативы, как только вы узнаетеwsCount, вы можете использоватьRedim haystack(wsCount)