Board logo

標題: excel vba 如果把二欄的資料copy到另二欄呢? [打印本頁]

作者: starlight    時間: 2019-2-1 17:19     標題: excel vba 如果把二欄的資料copy到另二欄呢?

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

我有想到使用 Worksheet_Change方式,但不知要怎麼寫vba
[attach]30046[/attach]
作者: a1234z    時間: 2019-3-7 23:19

您好,試著寫了ㄧ個簡單的,歡迎高手指正
到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    時間: 2019-9-10 11:06

直接E2輸入 =B2
再向下向右複製到F5
無須VBA是否更簡單
作者: Jogvsae86    時間: 2020-5-11 09:01

回復 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    時間: 2020-7-23 00:56

本帖最後由 cody 於 2020-7-23 00:58 編輯

參考看看

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

  29. End Sub
複製代碼





歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)