0

問題があります。すべての一意の値 (数値および英数字) を動的シートから別のシートにコピーしようとしています。フォーラムで素晴らしいスクリプトを見つけました。これはすぐに機能し、これを適応させました。問題は、すべての数値を除外しているように見え、私の人生では理由がわかりません!?! 手伝ってくれますか？

    Sub GetUniqueItems()
    Dim vData As Variant, n&, lLastRow&, sMsg$

    lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Cells(Rows.Count, "H").End(xlUp).Row
    If lLastRow = 1 Then Exit Sub '//no data

    vData = Worksheets(Worksheets("Summary").Range("A1").Value)._
    Range("H2:H" & lLastRow)
    Dim oColl As New Collection
    On Error Resume Next
    For n = LBound(vData) To UBound(vData)
    oColl.Add vData(n, 1), vData(n, 1)
    Next 'n

    For n = 1 To oColl.Count
    sMsg = oColl(n)
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
    Next 'n

    End Sub
4

2 に答える 2

2

アイテムのキーCollectionは文字列である必要があります。したがって、次の行を変更します。

oColl.Add vData(n, 1), vData(n, 1)

これに：

oColl.Add vData(n, 1), CStr(vData(n, 1))

また、コレクションに重複を追加する試みをOn Error Resume Nextコードがスキップするようにする必要がありますが、その 1 行にのみ使用する必要があります。そうしないと、コード内の他のエラーを隠す危険があります。(コードに実行時エラーが発生しなかった理由は、 が重複をバイパスする仕事を行うことに加えて、数値On Error Resume Nextを含むものもスキップしていたためです。AddsKeys

そのため、行を の直前に移動し、直後にoColl.Add追加しましOn Error Goto 0た。

完全なルーチンは次のとおりです。

Sub GetUniqueItems()
Dim vData As Variant, n&, lLastRow&, sMsg$
Dim oColl As Collection

lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value).Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub

vData = Worksheets(Worksheets("Summary").Range("A1").Value).Range("H2:H" & lLastRow)
Set oColl = New Collection
For n = LBound(vData) To UBound(vData)
    On Error Resume Next
    oColl.Add vData(n, 1), CStr(vData(n, 1))
    On Error GoTo 0
Next n

For n = 1 To oColl.Count
    sMsg = oColl(n)
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
Next n
End Sub

最後にもう 1 つ: のようなステートメントを避けDim oColl As New Collection、代わりに、私が行ったように 2 つのステップで宣言して設定する必要があります。その理由については、Chip Pearson のページを参照し、「自動インスタンス オブジェクト変数を使用しない」までスクロール ダウンしてください。

于 2013-06-30T14:42:24.970 に答える
1

以下のコードは、OP や他のユーザーにとって興味深いものであり、データの列から一意のリストを取得する効率的な方法であるため、以下に示しています。

Excel 2007 以降では、列をコピーし、そのRemove Duplicates機能を利用して独自のリストを取得できます。

Sub CreateUniqueList()
    Dim lLastRow As Long
    Dim wsSum As Worksheet
    Dim rng As Range

    Set wsSum = Worksheets("Summary")
    lLastRow = wsSum.Cells(Rows.Count, "H").End(xlUp).Row
    If lLastRow = 1 Then Exit Sub

    wsSum.Range("H2:H" & lLastRow).Copy wsSum.Cells(4, 1)
    wsSum.Range(wsSum.Cells(4, 1), wsSum.Cells(4 + lLastRow - 2, 1)). _
        RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

唯一のわずかな欠点は、最初に列全体をコピーする必要があることですが、これは、大量のデータ セットのパフォーマンスの向上に比べれば些細なことです。

于 2013-06-30T16:34:41.273 に答える