8

Excel 2010 に 100 行 x 3 列のデータ ブロックがあるとします。

列 C にはいくつかの重複が含まれています。

1, 1, 1, 2, 3, 4, 5, ..... , 97, 98

VBA を使用して重複行を削除したいので、98 行と 3 列が残っています。

1, 2, 3, ..... , 97, 98

Excel 2010 にそれを行うためのボタンがあることは知っていますが、その後のコードの残りの部分に干渉し、誤った結果が得られます。

さらに、次のようなメソッドではなく、配列で実行してから、結果をワークシートに貼り付けたいと思いますApplication.Worksheetfunction.countif(.....

次のようなものです：

Dim myarray() as Variant
myarray=cells(1,1).Currentregion.value

Dim a as Long

For a=1 to Ubound(myarray,1)

    'something here to 

Next a
4

9 に答える 9

8

同様の質問に答えました。使用したコードは次のとおりです。

Dim dict As Object
Dim rowCount As Long
Dim strVal As String

Set dict = CreateObject("Scripting.Dictionary")

rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count

'you can change the loop condition to iterate through the array rows instead
Do While rowCount > 1
  strVal = Sheet1.Cells(rowCount, 1).Value2

  If dict.exists(strVal) Then
    Sheet1.Rows(rowCount).EntireRow.Delete
  Else
    'if doing this with an array, then add code in the Else block
    ' to assign values from this row to the array of unique values
    dict.Add strVal, 0
  End If

  rowCount = rowCount - 1
Loop

Set dict = Nothing

配列を使用する場合は、同じ条件 (if/else) ステートメントを使用して要素をループします。アイテムがディクショナリに存在しない場合は、それをディクショナリに追加して、行の値を別の配列に追加できます。

正直なところ、最も効率的な方法は、マクロ レコーダーから取得したコードを適合させることだと思います。上記の機能を 1 行で実行できます。

    Sheet1.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes
于 2012-08-08T17:56:18.303 に答える
0

配列から重複 (および関連する行項目) を削除します

OP は に近い VBA ソリューションを望んでいたのでRemoveDuplicates、►dictionary を使用して一意の項目自体 ( dict.keys) ではなく、関連する最初の出現の行インデックスdict.items( ) を取得する配列アプローチを示します。

これらはLeaveUniques、►<code>Application.Index() 関数の高度な可能性から利益を得る手順を介して行データ全体を保持するために使用されます - Application.Index 関数のいくつかの特性を参照してください。

呼び出しの例

Sub ExampleCall()
'[0]define range and assign data to 1-based 2-dim datafield
    With Sheet1                   ' << reference to your project's sheet Code(Name)
        Dim lastRow: lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Dim rng:  Set rng = .Range("C2:E" & lastRow)
    End With
    Dim data: data = rng        ' assign data to 2-dim datafield
'[1]get uniques (column 1) and remove duplicate rows
    LeaveUniques data           ' << call procedure LeaveUniques (c.f. RemoveDuplicates)
'[2]overwrite original range
    rng.Clear
    rng.Resize(UBound(data), UBound(data, 2)) = data
End Sub

手順LeaveUniques

Sub LeaveUniques(ByRef data As Variant, Optional ByVal colNum As Long = 1)
'Purpose: procedure removes duplicates of given column number in entire array
    data = Application.Index(data, uniqueRowIndices(data, colNum), nColIndices(UBound(data, 2)))
End Sub

ヘルプ機能LeaveUniques

Function uniqueRowIndices(data, Optional ByVal colNum As Long = 1)
'Purpose: return data index numbers referring to uniques
'a) set late bound dictionary to memory
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
'b) slice e.g. first data column (colNum = 1)
    Dim colData
    colData = Application.Index(data, 0, colNum)
'c) fill dictionary with uniques referring to first occurencies
    Dim i As Long
    For i = 1 To UBound(colData)
        If Not dict.exists(dict(colData(i, 1))) Then dict(colData(i, 1)) = i
    Next
'd) return 2-dim array of valid unique 1-based index numbers
    uniqueRowIndices = Application.Transpose(dict.items)
End Function

Function nColIndices(ByVal n As Long)
'Purpose: return "flat" array of n column indices, e.g. for n = 3 ~> Array(1, 2, 3)
    nColIndices = Application.Transpose(Evaluate("row(1:" & n & ")"))
End Function
于 2020-10-25T19:52:52.027 に答える