返回列表 上一主題 發帖

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

starlight

帖子
9 
主題
6 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2019-1-23 
最後登錄
2019-2-1 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-2-1 17:19 | 只看該作者

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

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

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

a1234z

帖子
3 
主題
0 
精華
0 
積分
2 
點名
0  
作業系統
windows7 
軟體版本
office 2016 
閱讀權限
10 
註冊時間
2019-3-7 
最後登錄
2019-3-10 
2#
發表於 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

TOP

JasnH

帖子
6 
主題
2 
精華
0 
積分
50 
點名
276  
作業系統
windows 
軟體版本
office2016 
閱讀權限
20 
註冊時間
2019-9-6 
最後登錄
2024-11-24 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章
3#
發表於 2019-9-10 11:06 | 只看該作者
直接E2輸入 =B2
再向下向右複製到F5
無須VBA是否更簡單

TOP

Jogvsae86

帖子
13 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN10 
軟體版本
Office365 
閱讀權限
20 
註冊時間
2020-4-1 
最後登錄
2022-4-7 
4#
發表於 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

TOP

cody

帖子
16 
主題
2 
精華
0 
積分
55 
點名
0  
作業系統
macOS / Windows 
軟體版本
Office 2010/2019 
閱讀權限
20 
性別
男 
註冊時間
2020-7-9 
最後登錄
2021-8-7 
5#
發表於 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)

  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

  31. End Sub
複製代碼

TOP

        靜思自在 : 要批評別人時，先想想自己是否完美無缺。
返回列表 上一主題