求助合并VBA

三票

求助合并VBA

liulang0808

没看懂什么意思
猜一下
[fq3].Resize(UBound(ar)) = WorksheetFunction.Index(cr, 0, 16)

三票

liulang0808 发表于 2022-11-22 07:50
没看懂什么意思
猜一下
[fq3].Resize(UBound(ar)) = WorksheetFunction.Index(cr, 0, 16)

就是将第一个VBA合并到第二中，第一个VBA不再向表中写数据

yoonger

言不达意！看不懂你想要做什么……

pzwzwangzan

三票 发表于 2022-11-22 09:14
就是将第一个VBA合并到第二中，第一个VBA不再向表中写数据

那你写完之后再清空不行吗？

gxx75

不知道理解对不对
Sub 合并()
    Dim d, ar, cr(), i, j
    Range("fa3:fq65536").ClearContents
    ar = Range("c3:h" & [c65536].End(xlUp).Row)
    br = Range("ga1").CurrentRegion
    ReDim cr(1 To UBound(ar), 1 To 1)
    For i = 1 To UBound(ar)
       For j = 1 To UBound(br, 2)
        n = 0
          For k = 1 To UBound(br)
             For x = 1 To UBound(ar, 2)
                If br(k, j) = ar(i, x) Then
                  n = n + 1
                End If
             Next
          Next
          If n > 0 Then y = y + 1
       Next
        cr(i, 1) = y
       y = 0
    Next
    [fQ3].Resize(UBound(ar), 1) = cr
End Sub

阿力力

gxx75 发表于 2022-11-22 11:33
不知道理解对不对
Sub 合并()
    Dim d, ar, cr(), i, j

好,,