Мой цикл vba возвращает все правильные данные, когда я перехожу, но когда я запускаю макрос, это не

Question

Я попытался построить цикл, который отбрасывает определенные данные, когда он соответствует критериям, а затем публикует результаты в моем ' Основной "лист.

К сожалению, при запуске макроса он не отбрасывает все данные.

Однако, это, на мой взгляд, очень странно, когда вы проходите через это.

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

Я разместил мой код ниже:

Sub Loop_Data() 
    'BR stands for Blank Row 
    Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer, _ 
    SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range 

    BRMAin = Sheets("Main").Cells(Rows.Count, "W").End(xlUp).Row 
    BRData = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row 
    BRPhysNot = Sheets("PhysNot").Cells(Rows.Count, "A").End(xlUp).Row 

    Set SearchRange = Sheets("Data").Range("A3:A" & BRData) 
    Sheets("CoData").Activate 
    'assign j for number of rows (units) and i to start at 6 (column J) and end at 21 

    For j = 2 To 48 
     i = 35 
     Do Until i = 52 
       'criteria 
      If Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And Cells(j, i - 1) > 0 And Cells(j, i).Interior.Color = RGB(51, 51, 51) Then 
       'find duration o 
       m = 0 
       Do While Cells(j, i + m).Interior.Color = RGB(51, 51, 51) 
        m = m + 1 
       Loop 
       'check that the flagged is definitely matching criteria 
       If Cells(j, i + m) = 0 Then 
        'set string ID as the string of uni & period to find in the helper column of Data sheet 
        'set k as row which that occurs in 
        strID = Cells(1, i) & Cells(j, 3) 
        Set FindRow = SearchRange.Find(strID) 
        k = FindRow.Row 
        'Pull back data into main sheet 
        ThisWorkbook.Sheets("Main").Range("X" & BRMAin + 1) = Sheets("Data").Cells(k, 8) 
        ThisWorkbook.Sheets("Main").Range("V" & BRMAin + 1) = Sheets("Data").Cells(k, 4) 
        ThisWorkbook.Sheets("Main").Range("W" & BRMAin + 1) = Sheets("Data").Cells(k, 2) 
        ThisWorkbook.Sheets("Main").Range("Y" & BRMAin + 1) = m 
        ThisWorkbook.Sheets("Main").Range("Z" & BRMAin + 1) = Sheets("CoData").Cells(1, i) 
       End If 
      End If 
      i = i + 1 
     Loop 
    Next j 
End Sub 

Answer 1

Если Wait или DoEvents не работает, вместо того, чтобы использовать

Set FindRow = SearchRange.Find(strID) 
k = FindRow.Row 

Вы могли бы пойти с

k = 0 
For Each SearchCell In SearchRange 
    If SearchCell.Text = strID Then k = SearchCell.Row 
Next 

Answer 2

I Я не уверен на 100%, но я подозреваю, что это связано с тем, что у вас есть несколько листов, но вы ar особенно в отношении того, к какому листу обращаются ваши диапазоны. Я бы добавил, чтобы вызывать таблицы для каждого диапазона и ячейки. Посмотрите мой код ниже и дайте мне знать, если это поможет.

Sub Loop_Data() 'loops through CoData Sheet 

'BR stands for Blank Row 
Dim wb As Workbook, wsData As Worksheet, wsMain As Worksheet, wsPhys As Worksheet, wsCoData As Worksheet 
Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer 
Dim SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range 

Set wb = ThisWorkbook 
Set wsData = wb.Sheets("Data") 
Set wsMain = wb.Sheets("Main") 
Set wsPhys = wb.Sheets("PhysNot") 
Set wsCoData = wb.Sheets("CoData") 

BRMAin = wsMain.Cells(Rows.Count, "W").End(xlUp).Row 
BRData = wsData.Cells(Rows.Count, "A").End(xlUp).Row 
BRPhysNot = wsPhys.Cells(Rows.Count, "A").End(xlUp).Row 

Set SearchRange = wsData.Range("A3:A" & BRData) 
wsCoData.Activate 'Not necessary to activate a sheet if you need to pull data from it if you link a range to a specific sheet. 
'assign j for number of rows (units) and i to start at 6 (column J) and end at 21 
For j = 2 To 48 

    i = 35 
    Do Until i = 52 
     'criteria 
     If wsCoData.Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = RGB(51, 51, 51) Then 

      'find duration o 
      m = 0 
      Do While wsCoData.Cells(j, i + m).Interior.Color = RGB(51, 51, 51) 
       m = m + 1 
      Loop 

      'check that the flagged is definitely matching criteria 
      If wsCoData.Cells(j, i + m) = 0 Then 
       'set string ID as the string of uni & period to find in the helper column of Data sheet 
       'set k as row which that occurs in 
       strID = wsCoData.Cells(1, i) & wsCoData.Cells(j, 3) 
       Set FindRow = SearchRange.Find(strID) 
       k = FindRow.Row 

       'Pull back data into main sheet 
       wsMain.Range("X" & BRMAin + 1) = wsData.Cells(k, 8) 
       wsMain.Range("V" & BRMAin + 1) = wsData.Cells(k, 4) 
       wsMain.Range("W" & BRMAin + 1) = wsData.Cells(k, 2) 
       wsMain.Range("Y" & BRMAin + 1) = m 
       wsMain.Range("Z" & BRMAin + 1) = wsCoData.Cells(1, i) 
      End If 
     End If 

     i = i + 1 
    Loop 
Next j 

End Sub  

Я должен был догадаться о неподписанных диапазонах, я только предположил, что они должны были сделать с КОДАТА рабочего листа, так это то, что вы имели Использовались вчера.

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

Dim grey as Long 
grey = RGB(51, 51, 51) 

'Colors are just stored as Longs, in some cases Integer will work, but its mostly safer to just always stick to Long. 
'So your grey would equal 3355443: 51 + 51*256 + 51 *256*256 

'Example Uses... 
If wsCoData.Cells(j, i - 1).Interior.Color <> grey And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = grey Then 
    '...Your code 
End if 

Do While Cells(j, i + m).Interior.Color = grey 
    m = m + 1 
Loop