再请老师修改一下第二个代码

三票

再请老师修改一下第二个代码

三票

三票 发表于 2019-12-13 12:19
您好！第二个代码好像有问题。你费心看一下。

您好！第二个代码好像有问题。你费心看一下。

liulang0808

1. Sub ssss()
   
2.     Application.ScreenUpdating = False
   
3.     r = 1
   
4.     For j = 1 To Cells(Rows.Count, 5).End(3).Row
   
5.         If Cells(j, 5) = Cells(j, 8) And Cells(j, 6) = Cells(j, 9) Then
   
6.             Cells(r, 12).Resize(1, 4).Value = Cells(j, 3).Resize(1, 4).Value
   
7.             Cells(r, 16) = Cells(j, 10)
   
8.             r = r + 1
   
9.         End If
   
10.     Next j
    
11.     Application.ScreenUpdating = True
    
12. End Sub
    

复制代码

三票

liulang0808 发表于 2019-12-12 20:22

非常感谢！！

三票

liulang0808 发表于 2019-12-12 20:22

您能不能在工作表中做一下，加个按钮。

三票

liulang0808 发表于 2019-12-12 20:22

我增加数据后为什么不组合呢？请您帮助

三票

liulang0808 发表于 2019-12-12 20:22

增加数据后为什么不组合呢？

liulang0808

Sub ssss()
    Application.ScreenUpdating = False
    r = 1
    arr = Application.Intersect(Columns("c:p"), ActiveSheet.UsedRange)
    For j = 1 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            For i = 1 To UBound(arr)
                If arr(j, 3) = arr(i, 6) And arr(j, 4) = arr(i, 7) Then
                    For x = 1 To 4
                        arr(r, 9 + x) = arr(j, x)
                    Next x
                    arr(r, 14) = arr(j, 8)
                    r = r + 1
                    Exit For
                End If
            Next i
        End If
    Next j
    Application.Intersect(Columns("c:p"), ActiveSheet.UsedRange) = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

上次理解的不对，代码有问题
重新写一个，供参考

三票

liulang0808 发表于 2019-12-12 21:08
上次理解的不对，代码有问题
重新写一个，供参考

感谢，感谢！完全没问题

三票

liulang0808 发表于 2019-12-12 21:08
上次理解的不对，代码有问题
重新写一个，供参考

您好！第二个代码好像有问题。你费心看一下。