|
|
- Option Explicit
- Sub Demo()
- Dim objDic As Object, rngData As Range
- Dim i As Long, j As Long, iR As Long, sKey As String
- Dim arrData1, arrData2, arrData3(), lastRow As Long
- Dim oShtIn As Worksheet
- Const COLCNT = 12
- Const SCELL = "A4"
- Set oShtIn = Sheets("初始")
- Dim oShtXQ As Worksheet, oShtOut As Worksheet
- Set oShtXQ = Sheets("变更要求")
- Set oShtOut = Sheets("变更完成")
- Set objDic = CreateObject("scripting.dictionary")
- lastRow = oShtXQ.Cells(Rows.Count, 4).End(xlUp).Row
- arrData2 = oShtXQ.Range(SCELL, oShtXQ.Cells(lastRow, COLCNT)).Value
- For i = LBound(arrData2) + 1 To UBound(arrData2)
- If arrData2(i, COLCNT) = "删除" Then
- sKey = arrData2(i, 4) & "|" & arrData2(i, COLCNT - 1)
- objDic(sKey) = ""
- End If
- Next i
- lastRow = oShtIn.Cells(Rows.Count, 4).End(xlUp).Row
- arrData1 = oShtIn.Range(SCELL, oShtIn.Cells(lastRow, COLCNT)).Value
- ReDim arrData3(1 To UBound(arrData1) + UBound(arrData2), 1 To COLCNT)
- For i = LBound(arrData1) To UBound(arrData1)
- sKey = arrData1(i, 4) & "|" & arrData1(i, COLCNT - 1)
- If Not objDic.exists(sKey) Then
- iR = iR + 1
- For j = 1 To COLCNT - 1
- arrData3(iR, j) = arrData1(i, j)
- Next
- End If
- Next i
- For i = LBound(arrData2) + 1 To UBound(arrData2)
- If arrData2(i, COLCNT) = "新增" Then
- iR = iR + 1
- For j = 1 To COLCNT
- arrData3(iR, j) = arrData2(i, j)
- Next
- End If
- Next i
- arrData3(1, COLCNT) = "删除/增加"
- lastRow = oShtOut.Cells(Rows.Count, 4).End(xlUp).Row
- oShtOut.Range("5:" & lastRow).Clear
- With oShtOut.Range(SCELL).Resize(iR, COLCNT)
- .Value = arrData3
- .Borders.LineStyle = xlContinuous
- End With
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-9-27 18:01
发表于 2024-9-28 02:31
楼主