Question

我创建了一个现有模块，该模块会将文本文件导入到电子表格中，并且工作正常。我想加快处理速度的是自动删除行。导入的数据大小可能会有所不同，因此我无法使用固定范围。

Sub Import_Data()
    Dim Ret

    Ret = Application.GetOpenFilename("Text Files (*.txt), *.txt")

    If Ret <> False Then
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Ret, Destination:=Application.InputBox(prompt:="Select Input Cell", Type:=8))

        .Name = "Sample"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1, 2, 2, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

        End With
End If
End Sub

我想发生的是扫描导入的新文件。如果第2列中存在任何重复的值，请删除重复的行。

Answer 1

确定数据所处的范围，然后应用RemoveDuplicates方法。

 ActiveSheet.Range("$A$1:$C$20").RemoveDuplicates Columns:=2, Header:=xlYes

您的范围可以通过使用先前的代码导入数据后查找行号来构造

Dim myrow As Long
    ' get the row number of the last row of data in column A
    myrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    ' remove rows with duplicates in the second column, column B, in
    ' the table that sits in A1 to Cx
    ActiveSheet.Range("$A$1:$C" & myrow).RemoveDuplicates Columns:=2, Header:=xlYes

将代码添加到现有模块：删除第2行中的重复值

1 个答案: