将工作表上的值与整个工作表进行比较

时间:2017-12-30 04:28:20

标签: excel vba excel-vba

稍后进行多次修改:

我有一张excel电子表格,其中有几张4到8张是以前报告中的信息。我有包含所有更新值的工作表NIKE,其中包括当前项目和新项目,我已经找到了可以读取NIKE行的代码,并查看4到8页上是否有新行

可悲的是,我有一个部分正常的代码,这意味着代码可以读取并能够复制一些所需的行。

请参阅以下代码

Sub CompareNew()
Dim cellName, cellCl As Range
Dim uF, uFS As Long
Dim sName, ClName As String
Dim sDevice, sImported, sTracker As Worksheet

Application.ScreenUpdating = False

Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
uF = sImported.Range("A" & Rows.Count).End(xlUp).Row
Set sTracker = Sheets("Tracking Add-Delete") 'Hoja de tracking
uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row

For Each cellName In sImported.Range("A2:A" & uF)
sName = cellName
ClName = cellName.Offset(, 3)

Set sDevice = Worksheets(sName)
uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row

Set cl = sDevice.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole)
    If cl Is Nothing Then
        sDevice.Cells(uFS + 1, 2) = sDevice.Cells(uFS, 2) + 1
        sImported.Activate
        sImported.Range(Cells(cellName.Row, 2), Cells(cellName.Row, 10)).Copy sDevice.Cells(uFS + 1, 3)
        sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)") 'El codigo ya empieza a copiar informacion a la hoja de Tracking
        sImported.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 3)
        sImported.Cells(cellName.Row, 2).Copy sTracker.Cells(uFT + 1, 4)
        sImported.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 5)
        sTracker.Cells(uFT + 1, 6) = "Added"
    Else
    End If
Next cellName

Application.ScreenUpdating = True

End Sub

此代码将读取从NIKE向工作簿的其余部分添加的行,如果不存在则添加它们,之后我将它们复制到跟踪器表(当前将所有行添加到各自的工作表但不复制' em全部到跟踪表)

以下是相反的代码..

Sub CompareOld()
Dim cellName, cellCl As Range
Dim uF, uFS As Long
Dim sName, ClName As String
Dim sDevice, sImported, sTracker As Worksheet

Application.ScreenUpdating = False

wsName = Array("WAN Backbone-DC-RoutersSwitches", "Tools Servers", "Backbone Firewall", "Voice Messaging Managed Device", "NGWAN devices")

For i = 0 To UBound(wsName)
    Set sDevice = Worksheets(wsName(i))
    uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row
    Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
    uF = sImported.Range("A" & Rows.Count).End(xlUp).Row
    Set sTracker = Sheets("Tracking Add-Delete")
    uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row

    For Each cellName In sDevice.Range("E5:E" & uFS)
        ClName = cellName

        Set cl = sImported.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole)
        If cl Is Nothing Then
            sTracker.Activate
            sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)")
            sDevice.Cells(cellName.Row, 5).Copy sTracker.Cells(uFT + 1, 3)
            sDevice.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 4)
            sDevice.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 5)
            sTracker.Cells(uFT + 1, 6) = "Removed"
            sDevice.Rows(cellName.Row).EntireRow.Delete
        End If
    Next cellName
Next i

Application.ScreenUpdating = True

End Sub

这个将向后执行,比较当前存在的行,如果NIKE表中没有任何行,则将其从当前工作表中删除并复制到跟踪器表。 (这几乎不起作用......不知道为什么!)

附件是文件,请参阅VBA Module2,其中包含我遇到的麻烦。

下面的文件 https://drive.google.com/file/d/10rXA6fInX5g8zJucrnxsNHl-7vXBpIvz/view?usp=sharing

提前致谢!和往常一样,对不起......

1 个答案:

答案 0 :(得分:1)

而不是:

Set lookIn = Sheets(strName).Range("E5:B" & Range("E" & Rows.Count).End(xlUp).Row)

......你可以试试......

Set lookIn = Sheets(strName).Range*"E5:B" & !Sheets(strName).UsedRange.Rows.Count - x

...其中x是从底部跳过的行数。如果这是唯一一个有问题的话,至少对于最后一张表可能是一个好主意。

(该代码未经测试,因为我对您的数据一无所知,所以您可能不得不调整它。)

有些人会告诉你,UsedRange不是循环范围的好方法,因为如果你将数据放在一个单元格中,然后从该单元格中删除数据,它仍然被认为是“已使用”。

但我从来没有遇到过这个问题,而且比其他选择更快。