0

わかりましたので、検索して検索しましたが、探しているものがまったく見つかりません。

私はワークブックを持っていますが、基本的にやろうとしているのは、特定の範囲 (Sheet1 - E4:E12、E14:E20、I4:I7、I9:I12、I14:I17、および I19:I21) からエントリを取得して配置することですSheet2 の別のリストに表示されます。次に、シート 2 の新しいリストを、シート 1 にエントリが表示された回数で並べ替え、金額を表示するようにします。

例 http://demonik.doomdns.com/images/excel.png

上記の範囲から明らかなように、このサンプルははるかに小さく、すべてを説明する方法を理解するのに苦労していたので、画像が役立つと考えました.

基本的に、VBA (更新はボタンを押すことで初期化されます) を使用して、シート 1 からデータをコピーし、すべての範囲をシート 2 の 1 つのリストに入れようとしています。

より良い説明が必要な場合は、コメントしてお知らせください.

前もって感謝します！

別の詳細: Sheet1 の範囲内のデータが変更される可能性があるため、特定のものを検索することはできません。すべてが動的でなければなりません。

4

2 に答える 2

1

このデータから始めました

オリジナル

次のコードを使用して配列に読み込み、配列をソートし、重複する値をカウントしてから、結果をsheet2に出力します

Sub Example()
    Dim vCell As Range
    Dim vRng() As Variant
    Dim i As Integer

    ReDim vRng(0 To 0) As Variant

    Sheets("Sheet2").Cells.Delete
    Sheets("Sheet1").Select

    For Each vCell In ActiveSheet.UsedRange
        If vCell.Value <> "" Then
            ReDim Preserve vRng(0 To i) As Variant
            vRng(i) = vCell.Value
            i = i + 1
        End If
    Next

    vRng = CountDuplicates(vRng)

    Sheets("Sheet2").Select
    Range(Cells(1, 1), Cells(UBound(vRng), UBound(vRng, 2))) = vRng
    Rows(1).Insert
    Range("A1:B1") = Array("Entry", "Times Entered")
    ActiveSheet.UsedRange.Sort Range("B1"), xlDescending
End Sub

Function CountDuplicates(List() As Variant) As Variant()
    Dim CurVal As String
    Dim NxtVal As String
    Dim DupCnt As Integer
    Dim Result() As Variant
    Dim i As Integer
    Dim x As Integer
    ReDim Result(1 To 2, 0 To 0) As Variant

    List = SortAZ(List)

    For i = 0 To UBound(List)
        CurVal = List(i)

        If i = UBound(List) Then
            NxtVal = ""
        Else
            NxtVal = List(i + 1)
        End If

        If CurVal = NxtVal Then
            DupCnt = DupCnt + 1
        Else
            DupCnt = DupCnt + 1
            ReDim Preserve Result(1 To 2, 0 To x) As Variant

            Result(1, x) = CurVal
            Result(2, x) = DupCnt

            x = x + 1
            DupCnt = 0
        End If
    Next
    Result = WorksheetFunction.Transpose(Result)
    CountDuplicates = Result
End Function

Function SortAZ(MyArray() As Variant) As Variant()
    Dim First As Integer
    Dim Last As Integer
    Dim i As Integer
    Dim x As Integer
    Dim Temp As String

    First = LBound(MyArray)
    Last = UBound(MyArray)

    For i = First To Last - 1
        For x = i + 1 To Last
            If MyArray(i) > MyArray(x) Then
                Temp = MyArray(x)
                MyArray(x) = MyArray(i)
                MyArray(i) = Temp
            End If
        Next
    Next

    SortAZ = MyArray
End Function

最終結果：

結果

于 2013-08-02T15:21:03.733 に答える