比较范围和复制

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

循环1遍历Worksheet One上的所有行并标识需要复制的行，因此每次循环1捕获一行时循环2再次遍历所有这些行没有意义。

相反，只需使用循环1中标识的行中的作业编号，并使用循环3将其与工作表1上的作业编号进行比较。

因此，请删除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方便地是A列中包含作业编号的单元格。