Question

此代码应根据重复项对B列进行排序，并将重复项粘贴到新创建的工作表中。然后我想运行相同的代码来处理活动工作表（Sheet4）并将重复项移动到sheet5。

lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row

lr让我从上一张（Sheet1）算起。如何确保lr计数来自新的sheet4并始终从活动表中获取计数？

Sub duplicate()
Dim t As Single
t = Timer
Dim d As Object, x&, xcol As String
Dim lc&, lr&, k(), e As Range
Dim oWS1, oWS2 As Worksheet
xcol = "B"
Set wb = ThisWorkbook
sheetname = ActiveSheet.Name
Worksheets(sheetname).Activate

lc = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Column
lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row
ReDim k(1 To lr, 1 To 1)
Set d = CreateObject("scripting.dictionary")
For Each e In Cells(1, xcol).Resize(lr)
    If Not d.exists(e.Value) Then
        d(e.Value) = 1
        k(e.Row, 1) = 1
    End If
Next e
If d.Count = lr Then
    MsgBox "No duplicates"
    Exit Sub
End If

Cells(1, lc + 1).Resize(lr) = k
Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1
x = Cells(1, lc + 1).End(4).Row
Set tgt = wb.Sheets.Add(After:=Sheets(Sheets.Count))
tgtLastRow = tgt.Cells(Rows.Count, "A").End(xlUp).Row + 1

Cells(x + 1, 1).Resize(lr - x, lc).Copy tgt.Range("A" & tgtLastRow)
Cells(x + 1, 1).Resize(lr - x, lc).Clear
Cells(1, lc + 1).Resize(x).Clear
MsgBox "Code took " & Format(Timer - t, "0.00 secs")
MsgBox lr & " rows" & vbLf & lc & " columns" & vbLf & _
    lr - x & " duplicate rows"
End Sub

Answer 1

我想我可能找到了一种更简单的方法。如果sheet4是您想要的计数，那么只需将您的代码更改为：

Sheets("Sheet4").Select
sheetname = ActiveSheet.Name

lc = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Column
lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row

这将计算活动表的行数：

With ActiveSheet

Application.StatusBar = "Counting Rows" 'this just lets your user know what is happening
'you don't have to include this

Count1 = Application.CountA(Range("A:A")) 'if row A would give an accurate count

End With

有很多方法可以计算。如果这不是您想要的，请发表评论，我会建议另一个。

从活动表中获取计数，而不是从之前的活动表中获取计数

1 个答案: