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

Question

好的，所以我搜索了又搜索，但找不到我要找的东西。

我有一本工作簿，我基本上想做的是从特定范围（Sheet1 - E4:E12、E14:E20、I4:I7、I9:I12、I14:I17 和 I19:I21 ) 并将它们放在 Sheet2 上的单独列表中。然后，我希望 Sheet2 上的新列表按照条目在 Sheet1 上出现的次数进行排序，并显示数量。

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

显然，从我上面列出的范围可以看出，这个样本要小得多，哈哈，只是在试图弄清楚如何描述所有内容时遇到了麻烦，并认为图像会有所帮助。

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

如果需要更好的描述，请发表评论并告诉我，我一直很讨厌试图描述这样的东西，哈哈。

提前致谢！

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

Answer 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

最终结果：

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

到目前为止，它所做的只是将唯一值放入数组中，以便您可以计算每个值在该范围内的次数。