[發問] VBA問題: 設定範圍值同時變動時,要自動帶出公式

如附件
問題1
假設要設定在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
=================================
問題2
如果要寫成
一樣A1:A5的範圍值變動時
"在不同工作表 (ex 工作表2 )" 自動帶出B欄公式
'應該怎麼寫@-@?

test.zip (13.15 KB)

附件

樓主熱帖

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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2017-11-19 13:55 | 只看該作者

回復 1# renzhi2020
有關Excel VBA 可到 Excel程式區發問
試試看

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, E As Range
Set KeyCells = Range("A1:A5")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For Each E In KeyCells
If IsNumeric(E) Then '是數值
Sheets("結果").Cells(E.Row, "B") = E * 5 '給計算後的值
'***** 給公式 ****"
' Sheets("結果").Cells(E.Row, "B") = "=" & E.Address(, , , 1, 1) & "*5"
Else
Sheets("結果").Cells(E.Row, "B") = ""
End If
Next
End If
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

JasonChen576

小學生 Rank: 1

帖子: 14
主題: 4
精華: 0
積分: 16
點名: 0
作業系統: win 10
軟體版本: office 2010
閱讀權限: 10
性別: 男
註冊時間: 2018-1-29
最後登錄: 2018-2-14

3^#

發表於 2018-1-29 13:11 | 只看該作者

本帖最後由 JasonChen576 於 2018-1-29 13:13 編輯

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
      Set KeyCells = Range("A1:A5")

Dim myShtName As String
      myShtName = KeyCells.Worksheet.Name

Dim myRowsNum As Integer
      myRowsNum = Selection.Rows.Count

Dim mySht結果 As Worksheet
      Set mySht結果 = Worksheets("結果")

Dim myAddressOfTarget As String

Dim i As Integer

If Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then Exit Sub

For i = 0 To myRowsNum - 1 - Target.Row
      myAddressOfTarget = Target.Resize(1).Offset(i, 0).Address(0, 0, xlA1, 1, 1)
      mySht結果.Cells(Target.Row + i, "B") = "=" & myAddressOfTarget & "*5"
Next i
End Sub

TOP