Хранение строки и вывод на несколько ячеек в VBA - PullRequest
0 голосов
/ 13 марта 2019

В настоящее время у меня настроен код, который будет циклически проходить по всем рабочим листам в моей книге, вставлять дату в ячейку, в которой, если она не пуста, оставшиеся ячейки в строке будут заполнены данными.

В начале каждой строки - у меня есть формула, которая скажет «Ошибка», если в какой-либо из ячеек в этой строке есть ошибка.как это: enter image description here

Затем у меня есть другой цикл, который будет проходить через каждый лист и проверять, есть ли ошибки в этой ячейке, и если да, перейдет кПервый лист в книге к определенной ячейке и добавить «Ошибка на вкладке XYZ».Если есть несколько ошибок, он перейдет к следующему ряду и вставит его.Вот так это выглядит так:

enter image description here

Я думаю, что вместо повторения циклов по каждому листу, могу ли я сохранить текстовую строку в переменной / массивеи просто вставьте его на передний лист в конце цикла таким же образом?

Это код для цикла ошибок, который в данный момент настроен:

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 " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
        Else
            Selection.End(xlDown).Activate                
            ActiveCell.Offset(1, 0).Value = "Error on " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
        End If

    Else

    End If
Next I

1 Ответ

0 голосов
/ 14 марта 2019

Так что с этим я лично не хотел бы использовать массив. Я бы предпочел использовать коллекцию. Это проще, потому что вы не знаете параметров для вашего массива, поэтому трудно дать ему размеры.

Тем не менее найдите ниже возможное решение. Работайте в соответствии с вашими потребностями. Мне еще предстоит проверить или отладить себя. Но должен сделать свое дело.

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" & 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" & 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" & 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" & mySheet.Rows.Count).End(xlUp).Row + 1
        'now set the variable
        mySheet.Range("U" & lRow2).Value = "Error on" & myCollection(x)
    Next x

    Set myCollection = New Collection
    Set mySheet = Nothing

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...