[已解决]C欄的任一單元格作變更對象，B欄與D欄的單元格也作對應的變更

ioi_chan

C欄的任一格自動互換後，B欄與D欄也一起作相應的位置互換，請問各位老師這個B欄與D欄的VBA要怎樣寫，

再次感謝各位老師的幫助！謝謝！

最佳答案

月排行榜 / 总排行榜

france723

2017-5-27 18:25

1. Dim Ad
   
2. Dim ada
   
3. Dim adb
   
4. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
5. Application.EnableEvents = False
   
6. If Target.Column > 26 Or Target.Count > 10 Then Exit Sub
   
7. Ad = Target
   
8. ada = ActiveCell.Offset(0, -1)
   
9. adb = ActiveCell.Offset(0, 1)
   
10. Application.EnableEvents = True
    
11. End Sub
    
12. Private Sub Worksheet_Change(ByVal Target As Range)
    
13. If Target.Column > 26 Or Target.Count > 10 Then Exit Sub
    
14. Application.EnableEvents = False
    
15. Dim y, ar, i
    
16. y = Range("C65536").End(3).Row
    
17. ar = Range("a1:d" & y)
    
18.      For i = 1 To UBound(ar)
    
19.          If i <> Target.Row Then
    
20.              If Target = ar(i, 3) Then
    
21.                  Cells(i, 3) = Ad
    
22.                  Cells(i, 2) = ada
    
23.                  Cells(i, 4) = adb
    
24.                  Target.Offset(0, -1) = ar(i, 2)
    
25.                  Target.Offset(0, 1) = ar(i, 4)
    
26.              End If
    
27.          End If
    
28.      Next i
    
29. Application.EnableEvents = True
    
30. End Sub

复制代码

你修改我之前的代码，还是有点小问题，也帮你改过来了。

跳转到最佳答案楼层

france723

1. Dim Ad
   
2. Dim ada
   
3. Dim adb
   
4. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
5. Application.EnableEvents = False
   
6. If Target.Column > 26 Or Target.Count > 10 Then Exit Sub
   
7. Ad = Target
   
8. ada = ActiveCell.Offset(0, -1)
   
9. adb = ActiveCell.Offset(0, 1)
   
10. Application.EnableEvents = True
    
11. End Sub
    
12. Private Sub Worksheet_Change(ByVal Target As Range)
    
13. If Target.Column > 26 Or Target.Count > 10 Then Exit Sub
    
14. Application.EnableEvents = False
    
15. Dim y, ar, i
    
16. y = Range("C65536").End(3).Row
    
17. ar = Range("a1:d" & y)
    
18.      For i = 1 To UBound(ar)
    
19.          If i <> Target.Row Then
    
20.              If Target = ar(i, 3) Then
    
21.                  Cells(i, 3) = Ad
    
22.                  Cells(i, 2) = ada
    
23.                  Cells(i, 4) = adb
    
24.                  Target.Offset(0, -1) = ar(i, 2)
    
25.                  Target.Offset(0, 1) = ar(i, 4)
    
26.              End If
    
27.          End If
    
28.      Next i
    
29. Application.EnableEvents = True
    
30. End Sub

复制代码

你修改我之前的代码，还是有点小问题，也帮你改过来了。

ioi_chan

france723 发表于 2017-5-27 18:25
你修改我之前的代码，还是有点小问题，也帮你改过来了。

真的謝謝老師，就是要這種效果，太好了，再次感謝老師