请各位老师帮忙

fnjpn · 发表于 2024-9-11 09:19

本帖最后由 fnjpn 于 2024-9-11 09:22 编辑

小凡、、、发表于 2024-9-10 21:57
感觉已经很接近了，明天再研究

老师你好，是不是可以分两轮填写，第一轮不超40，第二轮不超10.
或者单一元素先填，多元素的，单元格内元素个数少的先填，并且选择出现总次数多的先填，每填一个，总次数对应减少一下

yynrzwh · 发表于 2024-9-11 09:46

思路是如果有多个数字，
取使用次数最少的那个。
Sub test()

Set d = VBA.CreateObject("scripting.dictionary")
lr = Cells(Rows.Count, 1).End(3).Row
ar = Range("a1").Resize(lr)
ReDim br(1 To lr, 1 To 1)
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
      t = Split(ar(i, 1), ",")
      m = UBound(t)
      If m > 0 Then
         n = 10 ^ 6
         For y = 0 To m
            If d(t(y)) < n Then
                  n = d(t(y))
                  imin = t(y)
            End If
         Next
         If d(imin) > 50 Then
            MsgBox "第" & i & "行所有数字个数大于50"
            Exit For
         End If
         br(i, 1) = imin
         d(t(x)) = d(imin) + 1
      Else
         br(i, 1) = t(0)
         d(t(x)) = d(t(0)) + 1
      End If

End If
Next

Range("t1").Resize(lr) = br

Range("w2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
Set d = Nothing
End Sub

填数.zip (41.25 KB, 下载次数: 4)

yynrzwh · 发表于 2024-9-11 09:47

fnjpn · 发表于 2024-9-11 09:52

yynrzwh 发表于 2024-9-11 09:47

先谢谢老师了

yynrzwh · 发表于 2024-9-11 09:56

改一下

fnjpn · 发表于 2024-9-11 10:14

yynrzwh 发表于 2024-9-11 09:47

老师你好，好像不行

yynrzwh · 发表于 2024-9-11 10:19

原数据我测试是可以的。
要不你把不行的数据发上来看下？

fnjpn · 发表于 2024-9-11 15:15

在这个文件上测试总不行，不知道为什么

https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1701441&pid=11580572

fnjpn · 发表于 2024-9-11 15:18

yynrzwh 发表于 2024-9-11 10:19
原数据我测试是可以的。
要不你把不行的数据发上来看下？

请老师看一下，为什么在这个文件上运行，结果就不对了

fnjpn · 发表于 2024-9-11 15:22

yynrzwh 发表于 2024-9-11 10:19
原数据我测试是可以的。
要不你把不行的数据发上来看下？

老师你好，原因找到了，是A列中的逗号不是英文状态

		自动登录	找回密码
密码			免费注册

[求助] 请各位老师帮忙

评分