Question

我在VBA中创建自动化代码，以比较两个单独的Excel文件中的单元格数据。我每天从我们的应用程序运行报告文件并比较记录是否在我的主文件中手动如果不是我插入它，所以我的宏将比较代码编号如果我的主excel没有然后记录自动插入并突出显示在每日报告中。

我有两个excel文件..

1）这是每日报告excel文件。

  Code Number   Code Type   Reason       Date           work start
   NCO3293     Normal   Upgrade      2018-02-14     2018-02-14 
   NCO1123     Normal   Fix      2018-02-14     2018-02-14 
   NCO2032     Normal   Improvement  2018-02-13     2018-02-13 
   NCO1102     Normal   Upgrade      2018-02-14     2018-02-14 
   NCO3042     Normal   Fix      2018-02-14     2018-02-14

2）这是我的主excel文件。

  Code Number   Code Type   Reason       Date           work start
   NCO2934     Normal   Upgrade      2018-02-14     2018-02-14 
   NCO4032     Normal   Fix      2018-02-14     2018-02-14 
   NCO3013     Normal   Improvement  2018-02-13     2018-02-13 
   NCO1102     Normal   Upgrade      2018-02-14     2018-02-14 
   NCO3042     Normal   Fix      2018-02-14     2018-02-14

如您所见，单元格编号1到3不同。所以我想让全细胞掌握excel ..

Sub SNC_Script()

Application.ScreenUpdating = False

Dim wb As Workbook
Dim ThisBook As Workbook  'Mster workbook
Dim SNCBook As Workbook   'SNC workbook
Dim c As Range, LR As Long, FR As Long
Dim CheckedOpen As Integer
Dim w1 As Worksheet, w2 As Worksheet

Set ThisBook = ThisWorkbook

'==================================
'Find SNC workbook if it is opened
'==================================
For Each wb In Workbooks
      If Left(wb.Name, 3) = "SNC" Then
        Set SNCBook = wb
        CheckedOpen = 1
      End If
Next

If CheckedOpen <> 1 Then
    MsgBox "Can't find SNC files..please open a SNC file"
Else
    Set w1 = ThisBook.Worksheets("Sheet1")
    Set w2 = SNCBook.Worksheets("Sheet1")
    LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
    With w1.Range("C1:C" & LR)
        .FormulaR1C1 = "RC[-2]&RC[-1]"
        .Value = .Value
    End With
    LR = w2.Cells(Rows.Count, 1).End(xlUp).Row
    With w2.Range("C1:C" & LR)
        .FormulaR1C1 = "RC[-2]&RC[-1]"
        .Value = .Value
    End With
    For Each c In w2.Range("C1", w2.Range("C" & Rows.Count).End(xlUp))
    FR = 0
    On Error Resume Next
    FR = Application.Match(c, w1.Columns(3), 0)
    On Error GoTo 0
    If FR = 0 Then
      c.Offset(, -2).Resize(, 2).Font.Bold = True
    End If
Next c
w1.Columns(3).ClearContents
w2.Columns(3).ClearContents

End If

Application.ScreenUpdating = True
End Sub

任何人都可以告诉我代码中的问题是什么吗？我真的很感激。

比较来自不同Excel文件的两个单元格

0 个答案: