excel vba 如果把二欄的資料copy到另二欄呢?

starlight

請問各位先進:
我想要先把excel的二欄(B, C)資料copy到另二欄(E, F)，
然後，當數值1或數值2二欄(B, C)任儲存格有變更時，(E, F)欄儲值格內容會跟著改變。

我有想到使用 Worksheet_Change方式，但不知要怎麼寫vba

下載 (16.1 KB)

2019-2-1 17:19

a1234z

您好，試著寫了ㄧ個簡單的，歡迎高手指正
到VBA該工作表下

Private Sub Worksheet_Change(ByVal Target As Range)
Dim E As Long
E = WorksheetFunction.CountA(Range("B:B")) + 1
Range("E1:F" & E).Value = Range("B1:C" & E).Value
End Sub

JasnH

直接E2輸入 =B2
再向下向右複製到F5
無須VBA是否更簡單

Jogvsae86

回復 2# a1234z


實際運行時，發現會當機，應該是觸發問題
修改如以下程式碼，就OK了
提供參考，如果有其他寫法，也請各位指教

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim E As Long
E = WorksheetFunction.CountA(Range("B:B")) + 1
Range("E1:F" & E).Value = Range("B1:C" & E).Value
Application.EnableEvents = True
End Sub

cody

參考看看

module:

1. Sub copyBCtoEF()
   
2.     With Worksheets("test1")
   
3.         .Range("E:F").Value = .Range("B:C").Value
   
4.     End With
   
5. End Sub

複製代碼

1. Sub doUNDO()
   
2.     With Application
   
3.         .EnableEvents = False
   
4.         .Undo
   
5.         .EnableEvents = True
   
6.     End With
   
7. End Sub

複製代碼

worksheet:

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. 
   
3.     Application.EnableEvents = False
   
4.    
   
5.     If Target.Row = 1 Then
   
6.         doUNDO
   
7.         MsgBox "不可更改標題"
   
8.         GoTo tagExit
   
9.     End If
   
10.    
    
11.     If (Target.Column = 2 Or Target.Column = 3) And (Target.Row >= 2 Or Target.Row >= 2) And Target.Count = 1 Then
    
12.         With Worksheets("test1")
    
13.             .Cells(Target.Row, Target.Column + 3).Value = .Cells(Target.Row, Target.Column).Value
    
14.         End With
    
15.         GoTo tagExit
    
16.     End If
    
17.    
    
18.    
    
19.    
    
20.     If (Target.Column = 2 Or Target.Column = 3) And (Target.Row >= 2 Or Target.Row >= 2) And Target.Count >= 2 Then
    
21.    
    
22.         With Worksheets("test1")
    
23.             .Range(.Cells(Target.Row, Target.Column + 3), .Cells(Target.Row + UBound(Target.Value2, 1) - 1, Target.Column + UBound(Target.Value2, 2) - 1 + 3)).Value = Target.Value2
    
24.         End With
    
25.         GoTo tagExit
    
26.     End If
    
27.   
    
28. tagExit:
    
29.     Application.EnableEvents = True
    
30. 
    
31. End Sub

複製代碼