Question

好的，所以我搜索并搜索过，找不到我想要的东西。

我有一本工作簿，而我基本上要做的是从某些范围中获取条目（Sheet1 - E4：E12，E14：E20，I4：I7，I9：I12，I14：I17，＆amp; I19： I21）并将它们放在Sheet2上的单独列表中。然后，我希望Sheet2上的新列表按照Sheet1上显示的条目的次数进行排序，并显示金额。

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

显然，我在上面列出的范围可以看出，这个样本是小得多的lol，只是在试图弄清楚如何描述所有内容并想出一个图像会有所帮助。

基本上我正在尝试使用VBA（更新将通过点击按钮进行初始化）从Sheet1复制数据并将所有范围放入Sheet2中的一个列表中，该列表按Sheet1上出现的次数排序，然后按字母顺序。

如果需要更好的描述，只需评论并让我知道，我总是在试图描述像这样的东西时很可怕。

提前致谢！

另一个细节：我无法搜索特定的东西，因为Sheet1范围内的数据可能会发生变化。一切都必须是动态的。

Answer 1

我从这个数据开始

Original

并使用以下代码将其读入数组，对数组进行排序，并计算重复值，然后将结果输出到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

结束结果：

Result

Answer 2

这是我为您开始的可能解决方案。你要求做的事情变得相当复杂。这是我到目前为止：选项明确

Sub test()
    Dim items() As String
    Dim itemCount() As String
    Dim currCell As Range
    Dim currString As String
    Dim inArr As Boolean
    Dim arrLength As Integer
    Dim iterator As Integer
    Dim x As Integer
    Dim fullRange As Range
    Set fullRange = Range("E1:E15")
    iterator = 0

    For Each cell In fullRange 'cycle through the range that has the values
        inArr = False
        For Each currString In items 'cycle through all values in array, if
        'values is found in array, then inArr is set to true
            If currCell.Value = currString Then 'if the value in the cell we
            'are currently checking is in the array, then set inArr to true
                inArr = True
            End If
        Next
        If inArr = False Then 'if we did not find the value in the array
            arrLength = arrLength + 1
            ReDim Preserve items(arrLength) 'resize the array to fit the new values
            items(iterator) = currCell.Value 'add the value to the array
            iterator = iterator + 1
        End If
    Next
    'This where it gets tricky. Now that you have all unique values in the array,
    'you will need to count how many times each value is in the range.
    'You can either make another array to hold those values or you can
    'put those counts on the sheet somewhere to store them and access them later.
    'This is tough stuff! It is not easy what you need to be done.
    For x = 1 To UBound(items)

    Next

End Sub

到目前为止所做的就是在数组中获取唯一值，以便计算每个数组在该范围内的次数。

在计算/删除重复项时Excel复制/排序数据

2 个答案: