[已解决]请教：对种类进行组合，所对应的具体数值去重

lygyjt

cutecpu 发表于 2021-6-28 17:24
你直接下載附件試試！

直接下载是这样的：

cutecpu

lygyjt 发表于 2021-6-28 17:25

您仔細看，代碼的「钮」是簡體的
而 實際按鈕名稱 「鈕」是繁體的

讓代碼 跟 實際按鈕名稱一致就行

lygyjt

cutecpu 发表于 2021-6-28 17:28
您仔細看，代碼的「钮」是簡體的
而 實際按鈕名稱 「鈕」是繁體的

好的，我先按老师说的做，哪不懂的再来请教啊。

lygyjt

cutecpu 发表于 2021-6-28 17:28
您仔細看，代碼的「钮」是簡體的
而 實際按鈕名稱 「鈕」是繁體的

向老师汇报一下：按您说的做，全对。之前是我用的版本不行。由于我的水平不行，又浪费老师许多精力了！最后想问下您，去重后的结果，能按从小到大排序吗？如果不太麻烦的话，请您再加上它？

cutecpu

lygyjt 发表于 2021-6-28 18:35
向老师汇报一下：按您说的做，全对。之前是我用的版本不行。由于我的水平不行，又浪费老师许多精力了！最 ...

新增、修改藍色部份代碼

Dim a, ar, c, d, list, n, m, r, num
Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   Set list = CreateObject("System.Collections.ArrayList")
   Select Case Application.Caller
      Case "按鈕 1": g = 1: n = [e1]:  m = [g1]:  c = "a":  [a2:ao1000] = ""
      Case "按鈕 2": g = 2: n = [au1]: m = [aw1]: c = "aq": [aq2:ce1000] = ""
      Case "按鈕 3": g = 3: n = [ck1]: m = [cm1]: c = "cg": [cg2:dy1000] = ""
   End Select
   ReDim num(1 To 1, 1 To m)
   a = Sheets(1).UsedRange
   ar = (g - 1) * (n + 1)
   r = 1: com 1, 1
End Sub
Sub com(k, i)
   If k > m Then
      r = r + 1
      Cells(r, c).Resize(1, m) = num
      list.Sort
      Cells(r, c).Offset(, 7).Resize(1, list.Count) = list.ToArray
      Exit Sub
   End If
   For i = i To n - m + k
      num(1, k) = a(ar + i, 1)
      For j = 2 To UBound(a, 2)
         Key = a(ar + i, j)
         If Key <> "" Then
            d(Key) = d(Key) + 1
            If d(Key) = 1 Then list.Add Key
         End If
      Next
      com k + 1, i + 1
      For j = 2 To UBound(a, 2)
         Key = a(ar + i, j)
         If Key <> "" Then
            d(Key) = d(Key) - 1
            If d(Key) = 0 Then d.Remove Key: list.Remove Key
         End If
      Next
   Next
End Sub

祝順心，南無阿彌陀佛！

lygyjt

cutecpu 发表于 2021-6-28 18:49
新增、修改藍色部份代碼

Dim a, ar, c, d, list, n, m, r, num

再次感谢版主的指点！

lygyjt

cutecpu 发表于 2021-6-27 17:21
Dim a, ar, c, d, n, m, r, num
Sub demo()
   Set d = CreateObject("Scripting.Dictionary")

老师，请通过一下QQ的申请