Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/oop/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA查找区分大小写的重复行而不是单元格并删除_Excel_Vba - Fatal编程技术网

Excel VBA查找区分大小写的重复行而不是单元格并删除

Excel VBA查找区分大小写的重复行而不是单元格并删除,excel,vba,Excel,Vba,看看下面贴出的精彩答案。但是,下面的答案仅比较第一列中要标记的每一行的值,然后删除 但是,我想看看第一列是否相同,如果相同,请检查所有其他列是否相同,如果整行存在,则标记它 tried amending the IF Not .Exists(v(i,1)) Then to IF Not .Exists(v(i,1)) and IF Not .Exists(v(i,2)) Then 没用也试过 IF Not .Exists(v(i,1)) Then

看看下面贴出的精彩答案。但是,下面的答案仅比较第一列中要标记的每一行的值,然后删除

但是,我想看看第一列是否相同,如果相同,请检查所有其他列是否相同,如果整行存在,则标记它

 tried amending the 
       IF Not .Exists(v(i,1)) Then to 
       IF Not .Exists(v(i,1)) and IF Not .Exists(v(i,2)) Then
没用也试过

   IF Not .Exists(v(i,1)) Then
    IF Not .Exists(v(i,2)) Then

Sub RemoveDuplicateRows()

Dim data As Range
Set data = ThisWorkbook.Worksheets("Sheet3").UsedRange

Dim v As Variant, tags As Variant
v = data
ReDim tags(1 To UBound(v), 1 To 1)
tags(1, 1) = 0 'keep the header

Dim dict As Dictionary
Set dict = New Dictionary
dict.CompareMode = BinaryCompare

Dim i As Long
For i = LBound(v, 1) To UBound(v, 1)
    With dict
        If Not .Exists(v(i, 1 And 2)) Then 'v(i,1) comparing the values in the first column
              tags(i, 1) = i
            .Add Key:=v(i, 1), Item:=vbNullString
         End If
      End With
Next i

Dim rngTags As Range
Set rngTags = data.Columns(data.Columns.count + 1)
rngTags.Value = tags

Union(data, rngTags).Sort key1:=rngTags, Orientation:=xlTopToBottom, Header:=xlYes

Dim count As Long
count = rngTags.End(xlDown).Row

rngTags.EntireColumn.Delete
data.Resize(UBound(v, 1) - count + 1).Offset(count).EntireRow.Delete

End Sub

在第一次尝试中,我认为解决方案是使用SQL语句只返回不同的行

但是,如果不支持VBA中的SQL语句来近似模拟区分大小写的行为,则不会像我希望的那样高效

尽管如此,VBA中唯一的替代方法(据我所知)是遍历数据集

尝试使用以下子流程,并告诉我它是如何进行的:

代码:

Sub remove_duplicates(ByVal wk_sheet As Worksheet, ByVal rng As Range)

'   +----------------------------------------------------------+
'   | DESCRIPTION:                                             |
'   |   Removes all duplicate whole rows in a range.           |
'   |   Case sensitive.                                        |
'   |                                                          |
'   | VARIABLES:                                               |
'   |   wk_sheet = Worksheet object where our data is stored.  |
'   |   rng = Range object where our data is stored.           |
'   |   arr = array to store the matrix.                       |
'   |   a = variables to store rows for comparison.            |
'   |   b = variables to store rows for comparison.            |
'   |   dirrng = string to store the references of rows        |
'   |            to delete.                                    |
'   |   rngc1 = string storing first column reference of       |
'   |           range.                                         |
'   |   rngc2 = string storing last column reference of        |
'   |           range.                                         |
'   |                                                          |
'   +----------------------------------------------------------+

    Dim arr As Variant, a As Variant, b As Variant
    Dim dirrng As String, rngc1 As String, rngc2 As String

    With rng
        arr = .Value
        rngc1 = Split(Mid(.Cells(1, 1).Address, 2), "$")(0)
        rngc2 = Split(Mid(.Cells(1, .columns.Count).Address, 2), "$")(0)
    End With

    For i = 1 To UBound(arr)
        a = Join(Application.WorksheetFunction.Index(arr, i, 0), "|")
        For r = 1 To UBound(arr)
            If i <> r And _
            (dirrng = "" Or _
             Not InStr(1, dirrng, _
                       rngc1 & i & ":" & rngc2 & i, vbBinaryCompare) > 0) Then
                b = Join(Application.WorksheetFunction.Index(arr, r, 0), "|")
                If a = b Then
                    If Len(dirrng) > 0 Then
                        dirrng = dirrng & "," & rngc1 & r & ":" & rngc2 & r
                    Else
                        dirrng = rngc1 & r & ":" & rngc2 & r
                    End If
                End If
            End If
        Next r
    Next i

    'Deleting all rows at once is more efficient than deleting one at time
    If Len(dirrng) > 0 Then rng.Range(dirrng).Delete Shift:=xlUp

End Sub
结果:


希望有帮助。

无法运行,如果没有,下标超出范围。存在(v(i,1和2)),因为1和2会导致零(0)。您好,感谢SQL查询中的这一点。由于连接字段,这些实际上是不同的行,比如说成本代码,例如每行有多个成本代码的发票,事实上,在这种情况下,我只想看到发票的一个实例。你还没有解决你的问题吗?如果是这样的话,请在你的问题中包括两幅图片:一幅显示初始数据示例,另一幅显示预期最终结果。这样,我就可以澄清我的解释,并且可以毫无问题地详细说明解决您的情况的代码。Hi no没有解决问题,而是选择了SQL解决方案
Sub test()
    Call remove_duplicates(ActiveSheet, ActiveSheet.Range("TABLE_CONTENT"))
End Sub