返回列表 上一主題 發帖

[發問] 範圍值內如何同步變動?

renzhi2020

帖子
21 
主題
7 
精華
0 
積分
60 
點名
0  
作業系統
Mac 
軟體版本
2011 
閱讀權限
20 
性別
男 
註冊時間
2011-6-4 
最後登錄
2020-2-18 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2017-11-6 09:54 | 只看該作者

[發問] 範圍值內如何同步變動?

請問各位大大:
假設要設定在A1:A5的範圍值 變動時
要自動帶出 B欄公式
但實際試,A欄一個一個key 可以帶出B欄公式
但若同時貼上A1~A5的值時, 公式只會跑B1就停止了  @-@
無法同時 B1~B5 都帶出公式
請問以下VBA 要怎麼改才能同時A貼B同全部帶出公式
====================
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A1:A5")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
    Cells(Target.Row, "B") = "=A" & Target.Row & "*5"
    End If
End Sub
=================================
衍申問題
如果要寫成
一樣A1:A5的範圍值 變動時
"在不同工作表 (ex 工作表2 )" 自動帶出B欄公式
'應該怎麼寫@-@?

test.zip (13.17 KB)

附件

收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2017-11-7 10:55 | 只看該作者
回復 6# renzhi2020
無限延伸?
原代碼沒注意是不同工作表寫入公式，至於會無限延伸倒是沒有這樣情形發生
就加個保險吧!
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Application.EnableEvents = False
  3. Dim A As Range
  4. If Intersect(Target, [A1:A5]) Is Nothing Then Exit Sub
  5. For Each A In Target
  6.   If Not Intersect(A, [A1:A5]) Is Nothing Then 工作表2.Range(A.Address).Offset(, 1).Formula = "=" & A.Address(, , , 1) & "*5"
  7. Next
  8. Application.EnableEvents = True
  9. End Sub
複製代碼
學海無涯_不恥下問

TOP

renzhi2020

帖子
21 
主題
7 
精華
0 
積分
60 
點名
0  
作業系統
Mac 
軟體版本
2011 
閱讀權限
20 
性別
男 
註冊時間
2011-6-4 
最後登錄
2020-2-18 
6#
發表於 2017-11-7 10:36 | 只看該作者
回復 3# Hsieh

Dear 大大

用您公式有個bug

全選delete時

公式會無限延申到當掉@-@
50 字節以內
不支持自定義 Discuz! 代碼

TOP

renzhi2020

帖子
21 
主題
7 
精華
0 
積分
60 
點名
0  
作業系統
Mac 
軟體版本
2011 
閱讀權限
20 
性別
男 
註冊時間
2011-6-4 
最後登錄
2020-2-18 
5#
發表於 2017-11-7 10:07 | 只看該作者
本帖最後由 renzhi2020 於 2017-11-7 10:08 編輯

回復 3# Hsieh

可以全部套用了

來研究一下@-@

非常感謝版主的指導

:)
50 字節以內
不支持自定義 Discuz! 代碼

TOP

renzhi2020

帖子
21 
主題
7 
精華
0 
積分
60 
點名
0  
作業系統
Mac 
軟體版本
2011 
閱讀權限
20 
性別
男 
註冊時間
2011-6-4 
最後登錄
2020-2-18 
4#
發表於 2017-11-7 09:58 | 只看該作者
回復 2# naruto018

Dear Naruto

是的,
工作表1變動, 工作表2自動填入公式
50 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2017-11-6 14:31 | 只看該作者
回復 1# renzhi2020
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Intersect(Target, [A1:A5]) Is Nothing Then Exit Sub
  3. For Each a In Target
  4.    a.Offset(, 1).Formula = "=" & a.Address & "*5"
  5. Next
  6. End Sub
複製代碼
學海無涯_不恥下問

TOP

naruto018

帖子
91 
主題
5 
精華
0 
積分
130 
點名
0  
作業系統
Win10 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
註冊時間
2016-5-14 
最後登錄
2020-5-17 
2#
發表於 2017-11-6 14:06 | 只看該作者
回復 1# renzhi2020

1.參考看看
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim KeyCells As Range
  3.     Set KeyCells = Range("A1:A5")
  4.     Set IntersectCells = Application.Intersect(KeyCells, Range(Target.Address))
  5.     If Not IntersectCells Is Nothing Then
  6.         For Each a In IntersectCells
  7.             Cells(a.Row, "B") = "=A" & a.Row & "*5"
  8.         Next
  9.     End If
  10. End Sub
複製代碼
2.衍申問題的意思是例如：
工作表1的A1變動
工作表2的B1填入=工作表1!A1*5
是舉例的這樣嗎?

TOP

        靜思自在 : 君子為目標，小人為目的。
返回列表 上一主題