2016-08-01 56 views
0

我试图比较两个不同工作簿上的两个单元格。如果相等,脚本应该在这些(相同的)工作簿上进一步比较另外两个不同的单元格,并突出显示那些不相等的单元格。比较两个单元格,如果相等,则比较两个不同的单元格,如果不等于,则突出显示结果

我已经试过如下:

Sub Compare() 
Dim mycell As Range 
Dim shtSheet1 As Worksheet 
Dim shtSheet2 As Worksheet 
Set shtSheet1 = Workbooks("100Series").Worksheets("Report") 
Set shtSheet2 = Workbooks("UserWorkbook").Worksheets("User") 
For Each mycell In shtSheet2.UsedRange 
    If Not mycell.Value = shtSheet1.Cells(mycell.Row, mycell.Column).Value Then 
    mycell.Interior.Color = vbRed 
    End If 
Next 
End Sub 

但是,这是行不通的。它会抛出Subscript out of range错误。我不确定什么超出范围。每张工作表都有3500行,2列宽。

我现在的代码有什么问题?

+1

是否想比较Worbook 1的Cell A1与Worbook 2等的Cell A1等(Cell B310与其他Workbook的Cell B310 ...)? –

+3

它在什么时候会将下标超出范围错误?如果它正在执行'Set shtSheet1 = Workbooks(“100Series”)。Worksheets(“Report”)'命令,可能是因为工作簿被称为“100Series.xlsx”(或类似的东西)。 – YowE3K

+0

当出现错误消息时,消息框中应该有一个“调试”按钮。如果你点击那个按钮,导致错误的行应该以黄色突出显示 – barrowc

回答

0

这样的事情?

Dim sht1 As Worksheet, sht2 As Worksheet 
Dim y As Integer, x As Integer 

Private Sub CompareStuff() 

    Set sht1 = Workbooks("Wb1.xlsm").Worksheets("Sheet1") 'Make sure to pick the right name. 
    Set sht2 = Workbooks("Wb2.xlsm").Worksheets("Sheet2") 
    y = 1 

    Do While y <= ActiveSheet.Columns("A").Cells.Find("*", _ 
        SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row 
     For x = 1 To 2 
      If sht1.Cells(y, x).Value <> sht2.Cells(y, x).Value Then 
       sht1.Cells(y, x).Interior.ColorIndex = 3 
       sht2.Cells(y, x).Interior.ColorIndex = 3 
      End If 
     Next x 
     y = y + 1 
    Loop 

End Sub 
+0

'Do While y <= ActiveSheet.Columns(“A”)。Cells.Find(“*”,_ SearchOrder:= xlByRows,LookIn:= xlValues,SearchDirection:= xlPrevious).Row' - 这是什么意思? –

+0

这只是发现填充的最后一行。避免循环遍历所有〜100万行。你也可以把它写在一行中,但是在我看来这样做很长,所以我用'_'来继续下一行的代码。 –

+0

我如何遍历整个行来找到匹配? –

0

谢谢,以及我想出了以下,它看起来工作正常。事情是我希望它停止前两列(在两个工作簿中),也忽略值中的空格。我该如何去做呢?

Sub Compare() 
    Dim shtSheet1 As Worksheet 
    Dim shtSheet2 As Worksheet 
    Set shtSheet1 = Workbooks("100Series").Worksheets("Report") 
    Set shtSheet2 = Workbooks("UserWorkbook").Worksheets("User") 
     For Each mycell In shtSheet1.UsedRange 
      If Not mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then 
      mycell.Interior.Color = vbRed 
      ElseIf mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then 
      If Not mycell.Offset(0, 1).Value = shtSheet2.Cells(mycell.Row, mycell.Column + 1).Value Then 
       mycell.Interior.Color = vbRed 
       End If 
      End If 
     Next 
    End Sub 
+0

任何人?我使用了修剪功能,希望能够将前后的空格移开,但这并不起作用。 'Application.WorksheetFunction.Trim(“shtSheet1”) Application.WorksheetFunction.Trim(“shtSheet2”)' –

+0

'如果不是mycell.Value = shtSheet2.Cells(mycell.Row,mycell.Column).Value Then mycell.Interior .Color = vbRed'有没有办法让mycell.Row值遍历同一列中的所有行? –

+0

你是什么意思“忽略价值观中的空间?” –

相关问题