比较范围和复制

我一直在创build一个小项目,允许用户从工作表导入和导出数据到另一个。 我将附上截图,试图解释我正在努力实现的目标。 我有我的程序的导入部分工作没有错误,我可以从我的第二个工作表中导入所有颜色为“红色”的作业。 然而,一旦工作表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 

你有三个For循环:

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

  2. For j = 4 To 31

  3. For i = 4 To 10

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

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

所以,删除For j = 4 To 31Next j ,并replace

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

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

因为greenjob方便地是列A中包含作业号的单元格。