Question

我对 Excel VBA 非常陌生，我制作了这个宏以根据列名“容器”删除重复项。现在excel中有2列名称为“Container”。

  Sub Remove_DupContainerPOL()
    
    'Removes Duplicate Containers
    
    Dim whs As Worksheet
    Dim lRow As Long, colNumber As Long
    Dim colh As String
    
    colh = "Container"
    lRow = Range("A1").End(xlDown).Row
    Set whs = Worksheets("POL")
    colNumber = Application.Match(colh, whs.Range("A1:AAA1"), 0)
    
         With whs.Range("A1:AAA" & lRow)
            .RemoveDuplicates Columns:=colNumber, Header:=xlYes
         End With
    
    End Sub

Original Excel File

这是列在 Excel 文件中的样子。现在，当我执行宏时，它以某种方式行为不端，不确定前面行中的整个数据是否被打乱并生成错误的输出。有什么方法可以让宏读取 3 列，即“容器”，并且仅基于它删除重复项？

此外，我正在添加详细说明。名为 Ocean 的选项卡有 2 列名为 Container！我的编码方式是，这个海洋中的数据创建了 2 个名为 POL 和 POD 的新选项卡，在该 POL 和 POD 选项卡中，我想根据创建错误输出的名为“Container”的列删除重复项。重复数据的主海洋选项卡。

POL 选项卡，其中宏对数据进行了混洗并给出了错误的输出

我的完整宏代码如下：

Sub Split_Ocean()

'------------------------------Filter on column Mode and split all Ocean moves into newsheet--------------------------

    Application.AskToUpdateLinks = False
    
    Dim wb As Workbook
    ' If the code is in the ActiveWorkbook you should use ThisWorkbook instead.
    Set wb = ActiveWorkbook
        
    ' Delete Target Worksheet.
    Dim FSht As Worksheet
    On Error Resume Next
    Set FSht = wb.Worksheets("Ocean")
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        FSht.Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    
    ' Define Target Worksheet.
    Set FSht = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    FSht.Name = "Ocean"
    
    ' Define Source Worksheet.
    Dim Tsht As Worksheet
    Set Tsht = wb.Worksheets("Main")
    With Tsht
        If Tsht.AutoFilterMode Then
            Tsht.AutoFilterMode = False
        End If
        ' 14 is column N
        .Range("A1").AutoFilter Field:=14, Criteria1:="Ocean"
        .AutoFilter.Range.Copy FSht.Range("A1")
    End With

'-------------------------------------------------Endforabovecode---------------------
'Wait for 3 sec

Application.Wait (Now + TimeValue("0:00:03"))
'Create POL

Dim Source As Worksheet
Dim Destination As Worksheet

'Checking whether "POL" sheet already exists in the workbook
For Each Source In ThisWorkbook.Worksheets
    If Source.Name = "POL" Then
        MsgBox "POL sheet already exist"
        Exit Sub
    End If
Next

ActiveWorkbook.Worksheets("Ocean").Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "POL"

'Autofit all contents in POL

ActiveWorkbook.Worksheets("POL").UsedRange.Columns.AutoFit


'Create POD & check whether "POD" sheet already exists in the workbook

For Each Source In ThisWorkbook.Worksheets
    If Source.Name = "POD" Then
        MsgBox "POD sheet already exist"
        Exit Sub
    End If
Next

ActiveWorkbook.Worksheets("Ocean").Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "POD"

'Autofit all contents in POD

ActiveWorkbook.Worksheets("POD").UsedRange.Columns.AutoFit

Application.Wait (Now + TimeValue("0:00:02"))

ActiveWorkbook.Worksheets("Main").AutoFilterMode = False
End Sub

Sub Remove_DupContainerPOL()

'Removes Duplicate Containers

Dim whs As Worksheet
Dim lRow As Long, colNumber As Long
Dim colh As String

colh = "Container"
lRow = Range("A1").End(xlDown).Row
Set whs = Worksheets("POL")
colNumber = Application.Match(colh, whs.Range("A1:E1"), 0)

     With whs.Range("A1:E1" & lRow)
        .RemoveDuplicates Columns:=colNumber, Header:=xlYes
     End With

End Sub

Sub Remove_DupContainerPOD()

'Removes Duplicate Containers

Dim whs As Worksheet
Dim lRow As Long, colNumber As Long
Dim colh As String

colh = "Container"
lRow = Range("A1").End(xlDown).Row
Set whs = Worksheets("POD")
colNumber = Application.Match(colh, whs.Range("A1:E1"), 0)

     With whs.Range("A1:E1" & lRow)
        .RemoveDuplicates Columns:=colNumber, Header:=xlYes
     End With

End Sub

Main Ocean tab where duplicate data.

POL Tab where Macro shuffled the data and gave wrong output

Answer 1

With whs.Range("A1:E1" & lRow) .RemoveDuplicates 应该与 whs.Range("A1:N" & lRow) 一起覆盖所有列（假设 N 是最后一列）。或者也许只是使用 With whs.UsedRange。

基于列名删除重复项的 VBA 宏

1 个答案: