VBA-根据意见更新文件

最新推荐文章于 2025-04-27 14:35:02 发布

Luke_Zheng

最新推荐文章于 2025-04-27 14:35:02 发布

阅读量319

点赞数

分类专栏： VBA 文章标签：其他

本文链接：https://blog.csdn.net/congconglili1/article/details/128122943

版权

VBA 专栏收录该内容

9 篇文章

订阅专栏

需求：

sheet1：原来的pipeline list

sheet2：校核后的pipeline list

将sheet1中的部分数据更新为sheet2的数据。

Option Explicit

Sub pipelinecheck()

Dim m1, m2, n As Integer
Dim sheet1, sheet2 As Worksheet
Dim i, j, k As Integer

Set sheet1 = ThisWorkbook.Worksheets("biao1")
Set sheet2 = ThisWorkbook.Worksheets("biao1 (2)")

m1 = sheet1.Range("A1").End(xlDown).Row
m2 = sheet2.Range("A1").End(xlDown).Row
n = sheet1.Range("A1").End(xlToRight).Column


For i = 2 To m1
    For j = 2 To m2
        If sheet1.Cells(i, 1).Value = sheet2.Cells(j, 1).Value Then
            For k = 2 To n
                If sheet1.Cells(i, k) = sheet2.Cells(j, k) Then
                    sheet1.Cells(i, k).Font.Color = vbBlue
                Else
                    sheet1.Cells(i, k) = sheet2.Cells(j, k)
                    sheet1.Cells(i, k).Interior.Color = vbYellow
                End If
            Next k
'        Else
'            sheet1.Cells(i, 1).Value = sheet1.Cells(i, 1) & "没找到"
                '——会导致每次循环的不相等值累计赋值。
        End If
    Next j
Next i

MsgBox "运行结束"

End Sub

好久没码了，码的费劲。