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

renzhi2020

如附件
問題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欄公式
'應該怎麼寫@-@?

JasonChen576

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

GBKEE

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

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

複製代碼