比较范围和复制

Question

我一直在创建一个小项目，允许用户将工作sheet 中的数据导入和导出到另一个。我将附上屏幕截图以尝试解释我想要实现的目标。我的程序的导入部分工作正常，我可以从我的第二个工作 sheet 中导入所有颜色 "Red" 的工作。但是，一旦该行在 worksheet 1 中更改为颜色 "Green"，它将被导出回 sheet 2，然后将曾经的 "Red" 作业更改为 "Green" 不影响 sheet 中的其他行 2.

我已尽力实现代码，但是在比较两个范围内的唯一单元格时，我总是遇到错误。

截至目前，当我运行代码时，它将复制该值 10 次并粘贴从行 "A4" 到行 "A14"

的所有数据

工作sheet一个

工作sheet 两个

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 循环：

For Each greenjob In Range("A4:A31")
For j = 4 To 31
For i = 4 To 10

循环 1 遍历工作表一上的所有行并确定需要复制的行，因此循环 2 每次循环 1 捕获一个行时再次遍历所有这些行没有意义。

相反，只需使用循环 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 列中包含作业编号的单元格。

比较范围和复制

Comparing Ranges and Copying

vba

excel

excel-2010