时间戳

首页 > 解决方案 > 从外部 excel VBA 更新电子表格

vba - 从外部 excel VBA 更新电子表格

问题描述

一段时间以来，我一直在研究此代码，从其他帖子中获取我能做到的，并边走边学。我是 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

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

标签： vbaexcel-2016

解决方案

这个块：

.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

而且会更好:)

推荐阅读