Сравнение диапазонов и копирование

Question

Я создаю небольшой проект, который позволит пользователю импортировать и экспортировать данные с рабочего листа в другой. Я приложу скриншоты, чтобы попытаться объяснить, чего я пытаюсь достичь. У меня есть раздел импорта моей программы, работающий без сбоев, и я могу импортировать все задания, которые имеют цвет «Красный» со второго рабочего листа. Однако, как только строка будет изменена на цвет «Зеленый» на листе 1, она будет экспортирована обратно на лист 2 и, в свою очередь, изменит однократное «красное» задание на «Зеленый», не производя другие строки на листе 2.

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

Как просто теперь, когда я запускаю код будет копировать значения в 10 раз и оклеивают все данные из строки «A4» грести «A14»

Рабочий лист Один

Рабочий лист Два

Sub Button3_Click() 

'@Author - Jason Hughes(AlmightyThud) 
'@Version - 1.0 
'@Date - 0/03/2015 
'@Description - To Export all Completed Jobs to the "Daily Work Orders" Spreadsheet 
'Once exported it will scan for the unique job number in the list and override the existing values 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

'Declare initial variables for this button' 
Dim copyComplete As Boolean 
copyComplete = False 
Dim lR As Long 
'----------------------------------' 
'#When this code is uncommented it will delete all values in column A#' 

Dim jobID As Range 
Dim jobID2 As Range 
Set jobID = Sheets("Daily Screen Update").Range("A4:A31") 
Set jobID2 = Sheets("Daily Work Orders").Range("A4:A10000") 


'----------------------------------' 

'Activate the sheet you will be looping through' 
ThisWorkbook.Sheets("Daily Screen Update").Activate 

'Simple loop that will loop through all cells to check if the cell is green' 
'If the cell is green then the loop will copy the cell, once copied the loop will check' 
'the "Daily Work Orders" Sheet for a job ID with a similar ID and paste over it' 
For Each greenjob In Range("A4:A31") 
    If greenjob.Cells.EntireRow.Interior.Color = RGB(146, 208, 80) Then 
     greenjob.Cells.EntireRow.Copy 
     For j = 4 To 31 
      For i = 4 To 10 
       If jobID.Cells(j, 1).Value = jobID2.Cells(i, 1).Value Then 
        Sheets("Daily Work Orders").Range("A" & j).PasteSpecial xlPasteAll 
        copyComplete = True 
       End If 
      Next i 
     Next j 
    End If 
Next 

'Make a check to ensure that the data has been copied 
If copyComplete = True Then 
    MsgBox ("All completed jobs have been have been added to Daily Work Orders") 
ElseIf copyComplete = False Then 
    MsgBox ("Nothing has been added to Daily Work Orders") 
End If 


Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.CutCopyMode = False 

End Sub 

Answer 1

у вас есть три For петли:

1. For Each greenjob In Range("A4:A31")

2. For j = 4 To 31

3. For i = 4 To 10

Loop 1 проходит через все строки на листе One и определяет те, которые должны быть скопированы, так Петля 2 проходит через все из этих строк снова каждый раз, когда Loop 1 ловит один, не имеет смысла.

Вместо этого, просто используйте номер задания из строки, указанной в петле 1 и сравнить его с работой номеров на листе 1 с помощью Loop 3.

Таким образом, удалить For j = 4 To 31 и Next j, и заменить

If jobID.Cells(j, 1).Value = jobID2.Cells(i, 1).Value Then 

с

If greenjob.Value = jobID2.Cells(i, 1).Value Then 

, так как это greenjob, удобно, ячейка в колонке А, который содержит онемение работу э.