从外部 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:UsersJames.R.Dickerson...9-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

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

此块:

.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

它会更好:)

相关内容

  • 没有找到相关文章

最新更新