0

今日、私は次の問題を抱えています: Excel に x 行 (いくつでも構いません) の 2 つの列があり、それぞれに文字列があります。

   A                B
 Apple            Potato
 Banana           Potato
 Apple            Potato
 Orange           Apple

各文字列は両方の列に表示できます。

次の結果を得る必要があります。

Fruit          Occurrencies
Apple               3
Banana              1
Potato              3
Orange              1

さて、私が考えていたよりもはるかに速い方法があることは確かです。あなたの助けに感謝します。私の解決策は、文字列を配列に 1 つずつ格納して、現在のスロットの前のスロットに既に含まれているかどうかを毎回チェックし、含まれていない場合は、その発生もカウントすることです。たとえば、すべての文字列を配列に格納した後 (これを と呼びますFruit()):

Dim Str() As Variant
Dim Flag As Boolean

For i = LBound(Fruit)+1 to Ubound(Fruit)
    Flag = True
    For j = i to LBound(Fruit)
        If Fruit(i) = Fruit(j) Then
            Flag = False
            Exit For
        End If
    Next
    If Flag = True Then
        Str(k,0) = Fruit(i)
        For y = LBound(Fruit) to UBound(Fruit)
            if Str(k,0) = Fruit(y) Then Str(k,1) = Str(k,1)+1
        Next
        k = k+1
    End If
Next

これは完全にクレイジーで、もっと簡単な解決策があることを知っています...私はそれを見つけることができません。

4

2 に答える 2

1

辞書オブジェクトを使用できます。私にはかなり簡単に見えます

Sub fruitsCount()

    Dim sourceRange As Range
    Dim sourceMem As Object
    Dim curRow as integer

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("SOURCE_SHEET")
        Set sourceRange = .Range("A1:B" & .Range("A" & .Rows.count).End(xlUp).row)
    End with

    Set sourceMem = CreateObject("Scripting.dictionary")

    For Each cell In sourceRange
        On Error GoTo ERREUR
        sourceMem.Add cell.Value, 1
        On Error GoTo 0
    Next

    curRow = 2

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("DESTINATION_SHEET")
        .Range("A1").Value = "Fruit"
        .Range("B1").Value = "Occurencies"
        For Each k In sourceMem.Keys
            .Range("A" & curRow).Value = k
            .Range("B" & curRow).Value = sourceMem(k)
            curRow = curRow + 1
        Next k
    End With

    Set sourceMem = Nothing

    Exit Sub

ERREUR:

    sourceMem(cell.Value) = sourceMem(cell.Value) + 1
    Resume Next

End Sub

編集: コードの背後にあるロジックは実際にはかなり単純で、(キー、値) ペアを収集できるディクショナリ オブジェクトに依存しています。ここで、キーは果物の名前になり、値は各果物の出現回数になります。コードが依存するディクショナリ オブジェクトの特徴は、キーの重複を許可しないことです。ディクショナリに既に存在するキーを追加しようとすると、実行時エラーが発生します。

したがって、コードはソース範囲のすべてのセルをスキャンし、その値をキーとして辞書に追加しようとします。

  • 操作が成功した場合、これはソース範囲内のその果物の最初の出現です - キーとしてディクショナリに追加され、そのペアの値は 1 に設定されます
  • それ以外の場合、果物は辞書のキーとして既に存在するため、果物を辞書に追加しようとするとエラーが発生します。次に、コードは ERREUR エラー ハンドラにジャンプして、辞書内の既存のフルーツ キーとペアになっている値をインクリメントし、そこから通常の実行を再開します。

明確にするのに役立つことを願っています

于 2014-07-22T12:50:53.037 に答える
0

あなたの答えを正解としてチェックし、助けを求めるために+1しますが、これをアレイでも機能させるための努力をコミュニティと共有したかったのです。 

Private Function FilesCount(SourceRange As Range) As Variant

    Dim SourceMem As Object
    Dim Occurrencies() As Variant
    Dim OneCell As Range
    Dim i As Integer

    Set SourceMem = CreateObject("Scripting.dictionary")

    For Each OneCell In SourceRange
        On Error GoTo Hell
        SourceMem.Add OneCell.Value, 1
        On Error GoTo 0
    Next

    ReDim Occurrencies(SourceMem.Count - 1, 1)

    For i = 0 To SourceMem.Count - 1
        Occurrencies(i, 0) = SourceMem.Keys()(i)
        Occurrencies(i, 1) = SourceMem.Items()(i)
    Next i

    Set SourceMem = Nothing

    FilesCount = Occurrencies

    Exit Function

Hell:

    SourceMem(OneCell.Value) = SourceMem(OneCell.Value) + 1
    Resume Next

End Function

(nx 2) 配列を返します。この配列には、n 個の名前と、選択した範囲内でのそれらの出現が含まれます。

于 2014-07-22T14:26:11.700 に答える