使用VBA删除Excel中的不重复数据 [英] delete non duplicate data in excel using VBA

问题描述

我尝试删除不重复的数据并保留重复的数据
我已经做了一些编码，但没有发生任何事情哦。这是错误。这个是我的代码。

  Sub mukjizat2（）
 Dim desc As String 
 Dim sapnbr As Variant 
 Dim shortDesc As String 
 
 
 X = 1 
i = 2 
 
 desc = Worksheets（process）。Cells（i，3）.Value 
 sapnbr = Worksheets（process）。Cells（i，1）.Value 
 shortDesc = Worksheets ）.Cells（i，2）.Value 
在工作表（进程）中执行。单元格（i，1）.Value< 
 
如果desc = Worksheets（process）。Cells（i + 1，3）.Value<工作表（process）。单元格（i，3）或工作表（process）。单元格（i + 1,2）工作表（进程）。单元格（i，2）然后
 Delete.EntireRow 
 Else 
工作表（output）。celss（i + 1，3）.Value = desc 
工作表（输出）。单元格（i + 1，1）.Value = sapnbr 
工作表（输出）。单元格（i + 1，2）.Value = shortDesc 
 X = X + 1 
结束如果
i = i + 1 
 
循环
 
 
 End Sub 
  

我做错了什么？

我期望什么：

  before：
 
 sapnbr | ShortDesc | Desc 
 11 |黑帽子|黑色牛仔帽复古
 12 |太阳镜|黑色墨镜
 13 |牛仔帽|黑色牛仔帽复古
 14 |头盔46 |传奇头盔
 15 | v面具| vandeta面具
 16 |头盔46 |瓦伦蒂诺罗西头盔复制品
  

之后

  sapnbr | ShortDesc | Desc 
 11 |黑帽子|黑色牛仔帽复古
 13 |牛仔帽|黑色牛仔帽复古
 14 |头盔46 |传奇头盔
 16 |头盔46 |华伦泰诺罗西头盔复制品
  

---

更新，使用编码@siddhart，唯一值被删除，但不是全部

http://melegenda.tumblr.com/image/70456675803

解决方案

像我在评论中提到的以上，代码逻辑中的主要缺陷是如果数据未排序，则它将失败。你需要用不同的逻辑来解决问题。

逻辑：

1. 使用 Countif 来检查值是否多次出现。


2. 将行号存储在临时范围内如果发现多个匹配


3. 删除代码末尾的临时范围。我们可以删除循环中的每一行，但这会减慢代码的速度。

代码

  Option Explicit 
 
 Sub mukjizat2（）
 Dim ws As Worksheet 
 Dim i As Long，lRow As Long 
 Dim delRange As Range 
 
'~~>这是你的表
设置ws = ThisWorkbook.Sheets（process）
 
与ws 
'~~>获取在Col A 
 lRow = .Range（A& .Rows.Count）.End（xlUp）.Row 
 
'~~>中的最后一行。循环行
对于i = 2 To lRow 
'~~>对于多次出现
如果.Cells（i，2）.Value<> 和.Cells（i，3）.Value<> 然后
如果Application.WorksheetFunction.CountIf（.Columns（2），.Cells（i，2））= 1和_ 
 Application.WorksheetFunction.CountIf（.Columns（3），.Cells （i，3））= 1然后
'~~>将您的行存储在温度范围
如果delRange不是，然后
设置delRange = .Rows（i）
 Else 
设置delRange = Union（delRange，.Rows（i）） 
结束如果
结束如果
结束如果
下一个
结束
 
'~~>删除范围
如果不是delRange是没有，然后delRange.Delete 
结束Sub 
  

ScreenShot

>

i try to remove non-duplicate data and keep the duplicate data i've done some coding, but nothing happen, oh. it's error. lol

this is my code.

Sub mukjizat2()
    Dim desc As String
    Dim sapnbr As Variant
    Dim shortDesc As String


    X = 1
    i = 2

    desc = Worksheets("process").Cells(i, 3).Value
    sapnbr = Worksheets("process").Cells(i, 1).Value
    shortDesc = Worksheets("process").Cells(i, 2).Value
    Do While Worksheets("process").Cells(i, 1).Value <> ""

    If desc = Worksheets("process").Cells(i + 1, 3).Value <> Worksheets("process").Cells(i, 3) Or Worksheets("process").Cells(i + 1, 2) <> Worksheets("process").Cells(i, 2) Then
    Delete.EntireRow
    Else
    Worksheets("output").celss(i + 1, 3).Value = desc
    Worksheets("output").Cells(i + 1, 1).Value = sapnbr
    Worksheets("output").Cells(i + 1, 2).Value = shortDesc
    X = X + 1
    End If
    i = i + 1

    Loop


    End Sub

what have i done wrong?

what i expect :

before :

sapnbr | ShortDesc | Desc
11     | black hat | black cowboy hat vintage
12     | sunglasses| black sunglasses
13     | Cowboy hat| black cowboy hat vintage
14     | helmet 46 | legendary helmet
15     | v mask    | vandeta mask
16     | helmet 46 | valentino rossi' helmet replica

after

sapnbr | ShortDesc | Desc
11     | black hat | black cowboy hat vintage
13     | Cowboy hat| black cowboy hat vintage
14     | helmet 46 | legendary helmet
16     | helmet 46 | valentino rossi' helmet replica

---

UPDATE, using coding by @siddhart, the unique value deleted, but not all,

http://melegenda.tumblr.com/image/70456675803

解决方案

Like I mentioned in my comment above, the main flaw in the code logic is that it will fail if the data is not sorted. You need to approach the problem with a different logic

Logic:

1. Use Countif to check of the value occurs more than once.
2. Store the row number in a temp range in case more than one match is found
3. Delete the temp range at the end of the code. We could have deleted each row in a loop but then that will slow down your code.

Code:

Option Explicit

Sub mukjizat2()
    Dim ws As Worksheet
    Dim i As Long, lRow As Long
    Dim delRange As Range

    '~~> This is your sheet
    Set ws = ThisWorkbook.Sheets("process")

    With ws
        '~~> Get the last row which has data in Col A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Loop through the rows
        For i = 2 To lRow
            '~~> For for multiple occurances
            If .Cells(i, 2).Value <> "" And .Cells(i, 3).Value <> "" Then
                If Application.WorksheetFunction.CountIf(.Columns(2), .Cells(i, 2)) = 1 And _
                Application.WorksheetFunction.CountIf(.Columns(3), .Cells(i, 3)) = 1 Then
                    '~~> Store thee row in a temp range
                    If delRange Is Nothing Then
                        Set delRange = .Rows(i)
                    Else
                        Set delRange = Union(delRange, .Rows(i))
                    End If
                End If
            End If
        Next
    End With

    '~~> Delete the range
    If Not delRange Is Nothing Then delRange.Delete
End Sub

ScreenShot:

这篇关于使用VBA删除Excel中的不重复数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！