请教老师：如何查找数组最多数并删除所在列？

zainan0810

各位老师，节日好！想请教的问题是：第一步，在sheet1中，从C列开始，往右的所有列中，找出存在个数最多的那个数值，然后将此数值写在sheet2的A1中，此数值存在的个数写在B1中；第二步，假设将第一步找出的数值所在列全部删除，在剩余列中找出存在个数最多的数值，然后将此数值写在sheet2的A2中，此数值存在的个数写在B2中；以此类推。。。直至所有列全部删除为止。
说明：在查找中，如果出现并列个数最多的，任选其中一个就行。
具体请教见例子： 查找数组最多数并删除所在列.rar (66.62 KB, 下载次数: 5)

2018-6-18 09:26 上传

点击文件名下载附件

vbee

Sub vbee()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.UsedRange
    brr = Sheet2.Range("a1:b" & UBound(arr))
    For i = 1 To UBound(arr)
        For j = 3 To UBound(arr, 2)
           If arr(i, j) <> "" Then d(arr(i, j)) = d(arr(i, j)) + 1
        Next j
       krr = d.keys
        mrr = d.items
        For k = 0 To UBound(krr) - 1
        dd = Application.Max(mrr)
            If mrr(k) = Application.Max(mrr) Then
                brr(i, 2) = mrr(k)
                brr(i, 1) = krr(k)
                Exit For
            End If
        Next k
        d.RemoveAll
      Next i
      Sheet2.Range("a1:b" & UBound(arr)).Clear
      Sheet2.Range("a1:b" & UBound(arr)) = brr
  End Sub

duquancai

过程中，把原始数据删了！这是最不礼貌的一种做法！！！

zainan0810

duquancai 发表于 2018-6-18 10:33
过程中，把原始数据删了！这是最不礼貌的一种做法！！！

谢谢duquancai老师的指教！怪我没说清，我的意思是，找出来的数值所在列不参与下一步的计算。因为我不太懂专业术语，所以，用个“假设将第一步找出的数值所在列全部删除”。老师您看我这样解释行吗？当然，也真诚的请老师有空帮我这个忙。

zainan0810

vbee 发表于 2018-6-18 10:14
Sub vbee()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.UsedRange

对不起vbee老师！上午不知为什么只看到duquancai老师的帖子了，没看到您的，所以。。。。真不好意思啊！有点没看懂的问题，还想请教下： 试验.rar (19.5 KB, 下载次数: 4)

2018-6-18 16:55 上传

点击文件名下载附件

vbee

zainan0810 发表于 2018-6-18 16:56
对不起vbee老师！上午不知为什么只看到duquancai老师的帖子了，没看到您的，所以。。。。真不好意思啊！ ...

A1,B1单元格不能空白，就行了

zainan0810

vbee 发表于 2018-6-19 10:06
A1,B1单元格不能空白，就行了

谢谢vbee老师的指点！白天有事，没上线，不好意思，回复晚了。再请教下您：B列应该是从大到小排列吧？而且有空格出现了。刚才我用一楼的例子算了下，最后列只有一个数，35，它应该在sheet2的B列中最后一个出现，因为它没有重复数，所以，只能留到最后。
不知我说的对不？给老师添麻烦了！