Сохранение строки и вывод в несколько ячеек в VBA

#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 Если этот код работает и решает вашу проблему, пожалуйста, отметьте как ответ.