#arrays #excel #vba #string
#массивы #excel #vba #строка
Вопрос:
В настоящее время у меня настроен код, который будет перебирать все листы в моей рабочей книге, вставлять дату в ячейку, которая, если она не пуста, будет заполнять оставшиеся ячейки в строке данными.
В начале каждой строки — у меня есть формула, которая скажет «Ошибка», если в какой-либо из ячеек в этой строке содержится ошибка. вот так:
Затем у меня есть другой цикл, который будет возвращаться к каждому листу и проверять, есть ли ошибка в этой ячейке, и если да, то перейдет к первому листу в рабочей книге к определенной ячейке и добавит «Ошибка на вкладке xyz». Если есть несколько ошибок, он перейдет к следующей строке вниз и вставит ее. Итак, это выглядит следующим образом:
Я думаю, вместо того, чтобы снова перебирать каждый лист, могу ли я сохранить текстовую строку в переменной / массиве и просто вставить ее на первый лист в конце цикла таким же образом?
Это код для цикла ошибок, который настроен в данный момент:
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Activate
Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).End(xlDown).Offset(0, -1).Activate
If ActiveCell.Value = "Error" Then
Application.Goto "ErrorCheck"
If ActiveCell.Offset(1, 0).Value = vbNullString Then
ActiveCell.Offset(1, 0).Value = "Error on " amp; ActiveWorkbook.Worksheets(I).Name amp; " " amp; Hour(Now) amp; "00"
Else
Selection.End(xlDown).Activate
ActiveCell.Offset(1, 0).Value = "Error on " amp; ActiveWorkbook.Worksheets(I).Name amp; " " amp; Hour(Now) amp; "00"
End If
Else
End If
Next I
Комментарии:
1. В настоящее время он работает плохо или что-то в этом роде?
2. на самом деле нет — просто кажется избыточным / хороший опыт обучения
3. Мне нравится ваш текущий подход, но если вы хотите использовать массив или что-то еще, посмотрите на redim preserve, а затем Google вставляет массивы в диапазоны.
Ответ №1:
Так что с этим я лично не хотел бы использовать массив. Я бы предпочел использовать коллекцию. Это проще, потому что вы не знаете параметров для своего массива, поэтому сложно задать ему размеры.
Тем не менее, ниже приведено возможное решение. Обработайте это в соответствии с вашими потребностями. Мне еще предстоит протестировать или отладить самому. Но должно сработать.
Sub ErrorCheck()
Dim x As Long, lRow1 As Long, lRow2 As Long
Dim myCollection As New Collection
Dim ws As Worksheet
Dim mySheet As Worksheet
Set mySheet = Sheets("ErrorCheckSheet")
'create the for loop to cycle through worksheets
For Each ws In ThisWorkbook.Worksheets
'set the lrow to iterate through column
'set the colum for your need - "Error" column
lRow1 = ws.Range("A" amp; ws.Rows.Count).End(xlUp).Row
'IF lRow does not match your cell, use a static variable ie. 50
'assuming your data starts in row 2 as per picture
For x = 2 To lRow1
'check each cell for error text
If ws.Range("A" amp; x).Text = "Error" Then
'when found add to collection
'adjust to meet your cell you want to input into collection
myCollection.Add ws.Range("B" amp; x).Text
End If
Next x
Next ws
'once you have completely cycled through your workbook your collection will now be loaded
For x = 1 To myCollection.Count
'set the lrow on the sheet you want to enter the data in
lRow2 = mySheet.Range("U" amp; mySheet.Rows.Count).End(xlUp).Row 1
'now set the variable
mySheet.Range("U" amp; lRow2).Value = "Error on" amp; myCollection(x)
Next x
Set myCollection = New Collection
Set mySheet = Nothing
End Sub
Комментарии:
1. будет ли end (x1Up).row работать в этом случае, если это все forumlas?
2. end (xlup) по-прежнему будет работать с формулами. Я только что дважды проверил это.
3. @novawaly Если этот код работает и решает вашу проблему, пожалуйста, отметьте как ответ.