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

我开始了该数据

，并用于下面的代码来读取到一个数组，数组进行排序，并将结果计数重复值，然后输出到Sheet

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 

所有这确到目前为止得到的唯一值放入数组，这样你可以指望每个人有多少次是在范围内。