帖子: 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! 代碼

naruto018

中學生 Rank: 2

帖子: 91
主題: 5
精華: 0
積分: 130
點名: 2
作業系統: Win10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2016-5-14
最後登錄: 2026-6-21

2^#

發表於 2017-11-6 14:06 | 只看該作者

回復 1# renzhi2020

1.參考看看

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:A5")
Set IntersectCells = Application.Intersect(KeyCells, Range(Target.Address))
If Not IntersectCells Is Nothing Then
For Each a In IntersectCells
Cells(a.Row, "B") = "=A" & a.Row & "*5"
Next
End If
End Sub

複製代碼

2.衍申問題的意思是例如：
工作表1的A1變動
工作表2的B1填入=工作表1!A1*5
是舉例的這樣嗎?

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2017-11-6 14:31 | 只看該作者

回復 1# renzhi2020

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A5]) Is Nothing Then Exit Sub
For Each a In Target
a.Offset(, 1).Formula = "=" & a.Address & "*5"
Next
End Sub

複製代碼

學海無涯_不恥下問

TOP

renzhi2020

中學生 Rank: 2

帖子: 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

renzhi2020

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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

Hsieh

超級版主 Rank: 8 Rank: 8

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2017-11-7 10:55 | 只看該作者

回復 6# renzhi2020
無限延伸?
原代碼沒注意是不同工作表寫入公式，至於會無限延伸倒是沒有這樣情形發生
就加個保險吧!

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim A As Range
If Intersect(Target, [A1:A5]) Is Nothing Then Exit Sub
For Each A In Target
If Not Intersect(A, [A1:A5]) Is Nothing Then 工作表2.Range(A.Address).Offset(, 1).Formula = "=" & A.Address(, , , 1) & "*5"
Next
Application.EnableEvents = True
End Sub

複製代碼

學海無涯_不恥下問

TOP