从外部Excel VBA更新电子表格

时间:2018-10-01 18:12:05

标签: vba excel-2016

我一直在这段代码上工作,从其他帖子中获取我所学到的东西,并不断学习。我是VBA的新手。我正在尝试从其他Excel工作表更新主电子表格。我已经编写了一个代码来检查C列的值,以及它是否在Master中具有一个不在另一个中突出显示红色行的值。如果另一张纸的值不是主纸的值,则插入整行并突出显示绿色。我似乎无法使用的部分是,当列C的值匹配时,如何使用新信息更新现有行。每当我尝试时,一切都会混乱。

这是我的代码:

    Sub FindDifferences()

    Application.ScreenUpdating = False
    Dim cell As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim wkb1 As Workbook
    Dim wkb2 As Workbook
    Dim wks1 As Worksheet
    Dim wks2 As Worksheet
    Dim lRow As Long
    Dim iCntr As Long
    Dim r1 As Range
    Dim r2 As Range
    Dim i As Integer
    Dim j As Integer
    Dim lastRow1 As Integer
    Dim lastRow2 As Integer
    Dim lastRow As Long
    Dim recRow As Long
    Dim p As Long
    Dim fCell As Range

    Set wkb1 = Workbooks.Open(Filename:="C:\Users\James.R.Dickerson\...\09-24-2018-2.xlsx.xlsm")
    Set wks1 = wkb1.Worksheets("Job List")
    Set wkb2 = ThisWorkbook
    Set wks2 = wkb2.Worksheets("Code 200 TECH ASSISTs")

    lRow = 200
    recRow = 1

    For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 1).Interior.Color = RGB(156, 0, 6) Then
            Rows(iCntr).Delete
        End If
    Next

    With wks1
        Set r1 = .Range("C2", .Cells(.Rows.Count, .Columns("C:C").Column).End(xlUp))
    End With

    With wks2
        Set r2 = .Range("C2", .Cells(.Rows.Count, .Columns("C:C").Column).End(xlUp))
    End With

    lastRow1 = wks2.UsedRange.Rows.Count
    lastRow2 = wks1.UsedRange.Rows.Count

    For i = 1 To lastRow1
        For j = 1 To lastRow2
            If r2(i).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If r1(j).Value = r2(i).Value Then
                    r2(i).EntireRow.Delete
                    r1(j).EntireRow.Copy
                    r2(i).EntireRow.Insert
                    r2(i).EntireRow.Interior.Color = RGB(255, 255, 255) 'White background
                    r2(i).EntireRow.Font.Color = RGB(0, 0, 0) 'Black font color
                    Application.CutCopyMode = False
                    Exit For
                Else
                    If InStr(1, r1(j).Value, r2(i).Value, vbTextCompare) > 0 Then
                        'You may notice in the above instr statement, I have used vbTextCompare instead of its numerical value, _
                        I find this much more reliable.
                        r2(i).EntireRow.Interior.Color = RGB(255, 255, 255) 'White background
                        r2(i).EntireRow.Font.Color = RGB(0, 0, 0) 'Black font color
                        Exit For
                    Else
                        r2(i).EntireRow.Interior.Color = RGB(156, 0, 6) 'Dark red background
                        r2(i).EntireRow.Font.Color = RGB(255, 199, 206) 'Light red font color
                    End If
                End If
            End If
        Next j
    Next i

    With wks1
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

        For i = 2 To lastRow
            'See if item is in Master sheet
            Set fCell = wks2.Range("C:C").Find(what:=.Cells(i, "C").Value, lookat:=xlWhole, MatchCase:=False)

            If Not fCell Is Nothing Then
                'Record is already in master sheet
                recRow = fCell.Row
            Else
                'Need to move this to master sheet after last found record
                .Cells(i, "C").EntireRow.Copy
                wks2.Cells(recRow + 1, "C").EntireRow.Insert
                wks2.Cells(recRow + 1, "C").EntireRow.Interior.Color = RGB(0, 190, 8)
                recRow = recRow + 1
            End If
       Next i
    End With


    Application.CutCopyMode = False

    wkb1.Close
    Application.ScreenUpdating = True
    'ActiveWorkbook.Save
    End Sub

更新是上面的代码工作正常,它只是跳过了几行,我不知道为什么。任何帮助表示赞赏。谢谢。

1 个答案:

答案 0 :(得分:0)

此块:

.Cells(p, "C").EntireRow.Copy
wks2.Cells(p, "C").EntireRow.Delete
wks2.Cells(recRow1 + 1, "C").EntireRow.Insert

的顺序错误,因为.Delete清空了复制缓冲区,因此您插入了一个空行。以此方式更改命令顺序:

wks2.Cells(p, "C").EntireRow.Delete
.Cells(p, "C").EntireRow.Copy
wks2.Cells(recRow1 + 1, "C").EntireRow.Insert

这会更好:)