我一直在这段代码上工作,从其他帖子中获取我所学到的东西,并不断学习。我是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
更新是上面的代码工作正常,它只是跳过了几行,我不知道为什么。任何帮助表示赞赏。谢谢。
答案 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
这会更好:)