请帮助修改一下宏

yvll

请帮助修改一下宏，谢谢！
运行宏，在AJ2单元格给出结果，但因为R3:AH52区域数据是公式生成的，所以目前的宏给出的结果是错误的。
正确的结果应该是 2,7,3,10 。
请修改一下宏，能在不去除R3:AH52区域内公式的基础上得出正确的结果。


Sub matching()
Dim arr, arr1, arr2, arr3, i%, j%, k&, l, m&, n&, p&, q&, s
n = [R65536].End(xlUp).Row
p = [Q1]
arr = Range("R3:AH" & n)
ReDim arr1(1 To 17)
ReDim arr2(1 To 17)
   For k = 1 To 17
     For l = 1 To n - 3
        If arr(l, k) > 0 Then
       arr1(k) = arr1(k) + 1
    End If
  Next l
Next k
    For k = 1 To 17
      If arr1(k) = Application.Max(arr1) Then i = k '最大列号
Next
s = i
For j = 1 To [Q1] - 1
    For k = 1 To 17 '求与最大列号匹配次数
      For l = 1 To n - 3
        If arr(l, k) > arr(l, i) And arr(l, i) = 0 Then
      arr2(k) = arr2(k) + 1
    End If
  Next l
Next k
      For k = 1 To 17
        If arr2(k) = Application.Max(arr2) Then  '最大列号
    m = k
    Exit For
  End If
Next
s = s & "," & m
      For l = 1 To n - 3
          If m = i Then Exit For
             If arr(l, i) < arr(l, m) And arr(l, i) = 0 Then
     arr(l, i) = arr(l, m)
     arr(l, m) = 0
  End If
Next l
ReDim arr2(1 To 17)
Next j
Range("AJ" & [AJ65536].End(xlUp).Row + 1) = s
End Sub
修改.rar (23.42 KB, 下载次数: 5)

2024-8-16 17:38 上传

点击文件名下载附件

liulang0808

楼主的具体需求是什么？
建议结合附件内容描述清楚

yvll

liulang0808 发表于 2024-8-16 18:52
楼主的具体需求是什么？
建议结合附件内容描述清楚

谢谢！
就是上面这段宏得出的结果是错误的，原因就是在数据区R3:AH52内的数据是公式生成的，如果是没用公式用手工输入的数据，这段宏就能给出正确的结果。
所以能否修改一下宏，能在不清除数据区公式的基础上得出正确的结果。

liulang0808

yvll 发表于 2024-8-16 19:06
谢谢！
就是上面这段宏得出的结果是错误的，原因就是在数据区R3:AH52内的数据是公式生成的，如果是没用 ...

建议楼主还是结合附件详细描述下需求吧
也不知道楼主所谓的首当输入数据是怎样的
没有个对应，把目前公式转换成数值，代码结果还是不变的

yvll

liulang0808 发表于 2024-8-16 19:15
建议楼主还是结合附件详细描述下需求吧
也不知道楼主所谓的首当输入数据是怎样的
没有个对应，把目前公 ...

我水平有限，真不知道再如何解释。
在上面的宏的第三行插入
[R3:AH52].Value = [R3:AH52].Value
得出的结果就正确了，但数据区R3:AH52内的公式都被删除了。我是想既不删除数据区R3:AH52内的公式，也能得到正确的结果。
【数据区R3:AH52内的原有公式：R3=IFERROR(COUNTIF($K3:$P3,COLUMN(A1))^0,"")】

liulang0808

增加了红色框内代码

yvll

liulang0808 发表于 2024-8-16 20:26
增加了红色框内代码

太好了，非常感谢您！