求助数据组合问题内容在附件

三票

求助数据组合问题内容在附件

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     For j = 3 To Cells(Rows.Count, 2).End(3).Row
   
4.         If Cells(j, 4) = Cells(j, 6) Then
   
5.             For i = 2 To 4
   
6.                 Cells(j, i + 8) = Cells(j, i)
   
7.             Next i
   
8.             For i = 7 To 8
   
9.                 Cells(j, i + 6) = Cells(j, i)
   
10.             Next i
    
11.         End If
    
12.     Next j
    
13.     Application.ScreenUpdating = True
    
14. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

三票

liulang0808 发表于 2018-7-11 07:46
附件内容供参考。。。。。。

D列数据与F列数只要相等就组合,每一个数据都组合,还有就是如果,B,C,D三列数据与F,G，H数据变化后也能组合

liulang0808

三票 发表于 2018-7-11 09:32
D列数据与F列数只要相等就组合,每一个数据都组合,还有就是如果,B,C,D三列数据与F,G，H数据变化后也能组合 ...

请结合附件内容进行举例说明

三票

liulang0808 发表于 2018-7-11 10:30
请结合附件内容进行举例说明

附件中数据用不同颜色进行了说明，请您帮助看一下

liulang0808

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Set Rng = Application.Intersect(Union([b3:f302], [h3:j302]), Target)
   
3.     If Rng Is Nothing Then Exit Sub
   
4.     Application.ScreenUpdating = False
   
5.     Application.EnableEvents = False
   
6.     For Each rn In Rng.Columns(1)
   
7.         If Cells(rn.Row, "f") = Cells(rn.Row, "h") Then
   
8.             For i = 2 To 6
   
9.                 Cells(rn.Row, i + 10) = Cells(rn.Row, i)
   
10.             Next i
    
11.             Cells(rn.Row, 17) = Cells(rn.Row, 9)
    
12.             Cells(rn.Row, 18) = Cells(rn.Row, 10)
    
13.         End If
    
14.     Next rn
    
15.     Application.EnableEvents = True
    
16.     Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

三票

Private Sub Worksheet_Change(ByVal Target As Range)
    Set Rng = Application.Intersect(Union([b3:f302], [h3:j302]), Target)
    If Rng Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each rn In Rng.Columns(1)
        If Cells(rn.Row, "f") = Cells(rn.Row, "h") Then
            For i = 2 To 6
                Cells(rn.Row, i + 10) = Cells(rn.Row, i)
            Next i
            Cells(rn.Row, 17) = Cells(rn.Row, 9)
            Cells(rn.Row, 18) = Cells(rn.Row, 10)
        End If
    Next rn
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
不行啊

三票

结果不对呀