麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 選擇下拉式清單自動填入 [打印本頁]

作者: bhsm 時間: 2023-4-8 16:39 標題: 選擇下拉式清單自動填入

請教達人:
1. 若E4=B4、F4=C4，F5值自動填入F9
2. 若E4=B4、F4=C5，F5值自動填入F10
3. 若E4=B4、F4=C6，F5值自動填入F11
4. 若E4=B5、F4=C4，F5值自動填入F12
5. 若E4=B5、F4=C5，F5值自動填入F13
6. 若E4=B5、F4=C6，F5值自動填入F14
請教VBA或函數如何寫?
[attach]36100[/attach]

作者: sillykin 時間: 2023-4-8 21:28

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Or Target.Address = "$F$4" Then
      Select Case Range("E4").Value
         Case "B4"
            Select Case Range("F4").Value
                  Case "C4"
                     Range("F5").Value = Range("F9").Value
                  Case "C5"
                     Range("F5").Value = Range("F10").Value
                  Case "C6"
                     Range("F5").Value = Range("F11").Value
            End Select
         Case "B5"
            Select Case Range("F4").Value
                  Case "C4"
                     Range("F5").Value = Range("F12").Value
                  Case "C5"
                     Range("F5").Value = Range("F13").Value
                  Case "C6"
                     Range("F5").Value = Range("F14").Value
            End Select
      End Select
End If
End Sub
試一下看看

作者: bhsm 時間: 2023-4-9 10:48

回復 2# sillykin
感謝sillykin大指導,我將您的程式碼放在工作表中,不知哪裡出錯,無法自動填入數值,煩請您再次指導,謝謝

作者: sillykin 時間: 2023-4-9 22:42

回復 3# bhsm

幫您修改了一下，請試試看這個版本：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Or Target.Address = "$F$4" Then
      If Range("E4").Value = "B4" Then
         Select Case Range("F4").Value
            Case "C4"
                  Range("F5").Value = Range("F9").Value
            Case "C5"
                  Range("F5").Value = Range("F10").Value
            Case "C6"
                  Range("F5").Value = Range("F11").Value
         End Select
      ElseIf Range("E4").Value = "B5" Then
         Select Case Range("F4").Value
            Case "C4"
                  Range("F5").Value = Range("F12").Value
            Case "C5"
                  Range("F5").Value = Range("F13").Value
            Case "C6"
                  Range("F5").Value = Range("F14").Value
         End Select
      End If
End If
End Sub

主要的改動是將第一個 Select Case 改成 If...ElseIf...End If，因為您要根據 E4 的值來分別處理不同的情況。另外，您也可以考慮使用資料驗證功能來建立下拉式清單，這樣可能會更簡單一些。

作者: Andy2483 時間: 2023-4-10 09:34

本帖最後由 Andy2483 於 2023-4-10 09:40 編輯

回復 1# bhsm

謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習字典與觸發,學習方案如下,請前輩參考

執行前:
[attach]36102[/attach]

[F4]輸入7 執行結果:
[attach]36103[/attach]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$E$4" Or .Address = "$F$4" Then
   Dim Y, i%, j%, T$, S
   Set Y = CreateObject("Scripting.Dictionary")
   For i = 4 To 5
      For j = 4 To 6
         T = Cells(i, 2) & "|" & Cells(j, 3)
         S = Cells(i + j + (3 ^ (i - 4)), 6)
         If Not Y.Exists(T) Then
            Y(T) = S
            ElseIf Y(T) <> S Then
               Y(T) = "無法辨識"
         End If
      Next
   Next
   [F5] = Y([E4] & "|" & [F4])
   If [F5] = "無法辨識" Then MsgBox "排列組合子重複無法辨識"
   Set Y = Nothing
End If
End With
End Sub

作者: bhsm 時間: 2023-4-10 10:22

回復 4# sillykin
感謝sillykin大再次指導,測試結果還是無法將數值填入F9~F14，能否請您打開我的壓縮檔看看我哪裡搞錯了？

作者: bhsm 時間: 2023-4-10 10:32

本帖最後由 bhsm 於 2023-4-10 10:35 編輯

回復 5# Andy2483
感謝Andy2483大指導,我將您寫的程式放入工作表1中後,得到的結果是F5的公式被清除了,所以也無法自動填入F9~F14,不知我在哪個環節出錯,能否請您幫我修正我的壓縮檔?謝謝

作者: Andy2483 時間: 2023-4-10 13:46

回復 7# bhsm

謝謝前輩回復
後學藉此帖練習公式,學習方案如下,請前輩參考

F9~F14公式:
=IFERROR(IF(E$4=INDIRECT("B"&(INT(ROW()/12)+4)),E$4,"")+IF(F$4=INDIRECT("C"&MOD(ROW(),3)+4),F$4,""),"")

[attach]36106[/attach]

PS:5樓方案的VBA程式碼需刪除

作者: bhsm 時間: 2023-4-10 14:34

回復 8# Andy2483
謝謝Andy2483大的指導,可以用了,但如果希望改變E4或F4時之前的數值也要保留該如何處理?
例如:E4=5、F4=9則F9=14,但如果更改E4=10,F4=7時,希望F9=14被保留不被清除掉,同時顯示F9=14.F13=17------,請不吝指教,謝謝

作者: Andy2483 時間: 2023-4-10 15:13

本帖最後由 Andy2483 於 2023-4-10 15:15 編輯

回復 9# bhsm

如果希望改變E4或F4時之前的數值也要保留該如何處理?
例如:E4=5、F4=9則F9=14,但如果更改E4=10,F4=7時,希望F9=14被保留不被清除掉,同時顯示F9=14.F13=17------

謝謝前輩再回復
後學藉此帖研究VBA方案如下,請前輩參考

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$E$4" Or .Address = "$F$4" Then
   Dim Y, i%, j%, T$, S, Brr
   Set Y = CreateObject("Scripting.Dictionary")
   Brr = [F9].Resize(6, 1)
   For i = 4 To 5
      For j = 4 To 6
         T = Cells(i, 2) & "|" & Cells(j, 3)
         S = Val(Cells(i, 2)) + Val(Cells(j, 3))
         N = N + 1: Y(T) = S
         If T = [E4] & "|" & [F4] Then Brr(N, 1) = Y(T)
      Next
   Next
   [F9].Resize(6, 1) = Brr
   Set Y = Nothing: Erase Brr
End If
End With
End Sub

作者: bhsm 時間: 2023-4-10 15:56

回復 10# Andy2483
衷心感謝Andy2483大的指導,正是小弟想要的,不知您是否有空可在您的程式碼中加入中文說明?讓小弟學習,謝謝

作者: Andy2483 時間: 2023-4-10 16:25

本帖最後由 Andy2483 於 2023-4-10 16:27 編輯

回復 11# bhsm

謝謝前輩,以下心得註解請參考
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'↑當使用者或外部連結變更工作表中的儲存格時會發生此事件
With Target
'↑以下是關於觸發事件的程序
If .Address = "$E$4" Or .Address = "$F$4" Then
'↑如果觸發儲存格是[E4] 或[F4]的位址
   Dim Y, S, Brr, i%, j%, T$, N&
   '↑宣告變數:(Y,S,Brr)是通用型變數,(i,j)是短整數,T是字串變數
   'N是長整數
   Set Y = CreateObject("Scripting.Dictionary")
   '↑令Y這通用型變數是字典
   Brr = [F9].Resize(6, 1)
   '↑令Brr這通用型變數是二維陣列,以[F9]向下擴展6格的儲存格值帶入
   For i = 4 To 5
   '↑設順迴圈!i從4到 5
      For j = 4 To 6
      '↑設順迴圈!j從4到 6
         T = Cells(i, 2) & "|" & Cells(j, 3)
         '↑令T這字串變數是 i迴圈列B欄儲存格值連接 "|",
         '再連接 j迴圈列C欄儲存格值之後的新字串
         S = Val(Cells(i, 2)) + Val(Cells(j, 3))
         '↑令S這通用型變數是 i迴圈列B欄儲存格值轉化為數字值,
         '加上j迴圈列C欄儲存格值轉化為數字值之後的新數值
         N = N + 1: Y(T) = S
         '↑令N這長整數變數累加1
         '令以T變數為key,item是S變數,納入Y字典
         If T = [E4] & "|" & [F4] Then Brr(N, 1) = Y(T)
         '↑如果T變數(字串)同
         '[E4]儲存格值連接"|" 再連接[F4]儲存格值組成的新字串??
         '就令N變數列第1欄Brr陣列值是以T變數查Y字典的item值
      Next
   Next
   [F9].Resize(6, 1) = Brr
   '↑[F9]向下擴展6格的儲存格值以 Brr陣列值帶入
   Set Y = Nothing: Erase Brr
   '↑釋放變數
End If
End With
End Sub

作者: bhsm 時間: 2023-4-10 16:52

回復 12# Andy2483
感謝Andy2483大不厭其煩的指導,後進會好好拜讀消化,有問題再請教您,感恩

作者: Andy2483 時間: 2023-4-11 07:07

回復 13# bhsm

謝謝前輩不嫌棄,請前輩常上論壇一起學習
祝順心常樂

作者: bhsm 時間: 2023-4-11 13:03

回復 14# Andy2483
請問Andy2483大：這是我在網路上看到的程式碼，它的計算所得會由I1開始填入，若我想由G7開始填入，請問該如何修改?謝謝

作者: Andy2483 時間: 2023-4-11 13:28

回復 15# bhsm

謝謝前輩
1.若不同主題,請另發主題給前輩們幫忙
2.下午剛接到一份急趕的工作需立馬處理,再撥空研究前輩的範例

作者: bhsm 時間: 2023-4-11 13:58

回復 16# Andy2483
謝謝您,工作優先

作者: Andy2483 時間: 2023-4-11 16:42

回復 15# bhsm

謝謝前輩
以下是學習方案,請前輩參考

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$F$3" Or .Address = "$H$3" Then
   If [G7] = "" Then
      [G7] = [G4]
      Else
         [G65536].End(3).Item(2) = [G4]
   End If
End If
End With
End Sub

作者: bhsm 時間: 2023-4-11 18:16

回復 18# Andy2483
真是萬分感謝您，在百忙之中仍為小弟解惑，感恩、謝謝

作者: Andy2483 時間: 2023-4-12 07:30

回復 19# bhsm

謝謝論壇,謝謝各位前輩,謝謝前輩再回復
後學接到的工作很快就完成了,學習了陣列與字典,程式設計的邏輯更清楚,工作效率提升多倍,
設計的程式執行的效率提升上百倍,以前執行30分鐘,現在只要10秒鐘
勤練習是很重要的,謝謝前輩一起上論壇學習

Private Sub Worksheet_Change(ByVal Target As Range)
'↑當使用者或外部連結變更工作表中的儲存格時會發生此事件
With Target
'↑以下是關於觸發事件的程序
If .Address = "$F$3" Or .Address = "$H$3" Then
'↑如果觸發儲存格是[F3] 或[H3]的位址
   If [G7] = "" Then
   '↑如果[G7]儲存格值是空字元
      [G7] = [G4]
      '↑令[G7]儲存格值是 [G4]儲存格值
      Else
         [G65536].End(3).Item(2) = [G4]
         '↑否則令G欄最後一個有內容儲存格的下方一格值是 [G4]儲存格值
   End If
End If
End With
End Sub

作者: bhsm 時間: 2023-4-12 21:38

回復 20# Andy2483
謝謝您的解說，VBA實在太高深了，我曾試著自己解決，但是真的”不會就是不會”，只能依您的程式碼來試著理解，真的很幸運有您的不吝賜教，再次深深一鞠躬，真的很謝謝您。

作者: Andy2483 時間: 2023-4-14 08:44

回復 21# bhsm

謝謝前輩回復
邏輯是可以訓練的,例如厚臉皮的學生就很笨學了十幾年還很認真的學,不放棄
這麼優質的學習平台怎捨得讓真的”不會就是不會”成為事實呢?
一天進步一點點就可以了

作者: 准提部林 時間: 2023-4-21 13:55

利用 index 值填充//
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j%, k%
With Target
   If .Address <> "$E$4" And .Address <> "$F$4" Then Exit Sub
   j = Abs(([e4] = [b4]) + ([e4] = [b5]) * 4)
   k = Abs(([f4] = [c4]) + ([f4] = [c5]) * 2 + ([f4] = [c6]) * 3)
   If j * k Then [f9].Cells(j + k - 1) = [f5]
End With
End Sub

作者: bhsm 時間: 2023-4-22 10:49

回復 23# 准提部林
感謝准提部林大教導另一種方式,晚輩試了試,無法顯示數值,煩請您再次指導,謝謝

作者: 准提部林 時間: 2023-4-22 20:57

回復 24# bhsm

F5 是空的~~~~~~~~~~~~~~

作者: bhsm 時間: 2023-4-23 10:38

回復 25# 准提部林
謝謝准提部林大提醒,已解決,感恩

作者: Andy2483 時間: 2023-4-24 08:32

本帖最後由 Andy2483 於 2023-4-24 08:36 編輯

回復 23# 准提部林

謝謝論壇,謝謝前輩指導
後學學習心得如下,請前輩再指導

'利用 index 值填充//
https://learn.microsoft.com/zh-t ... sheetfunction.index
Private Sub Worksheet_Change(ByVal Target As Range)
'↑當使用者或外部連結變更工作表中的儲存格時會發生此事件。
Dim j%, k%
'↑宣告變數:(j,k)是短整數
With Target
'↑以下是關於觸發的程序
   If .Address <> "$E$4" And .Address <> "$F$4" Then Exit Sub
   '↑如果觸發格的位址不是 "$E$4"而且也不是 "$F$4" 就結束程式執行
   j = Abs(([e4] = [b4]) + ([e4] = [b5]) * 4)
   '↑令j這短整數是絕對值(布林值 + 布林值 *4)
   '如果[e4] = [b4] 其布林值是1,再如果[e4] = [b5]布林值是0*4=0 ,結果值是1
   '如果[e4] = [b4] 其布林值是0,再如果[e4] = [b5]布林值是1*4=4 ,結果值是4
   k = Abs(([f4] = [c4]) + ([f4] = [c5]) * 2 + ([f4] = [c6]) * 3)
   '↑令k這短整數是絕對值(布林值 + 布林值 *2)+(布林值 *3)
   '[f4]=[c4]_其布林值是1,[f4]=[c5]_布林值是0*2=0,[f4]=[c6]是0*3=0,結果值是1
   '[f4]=[c4]_其布林值是0,[f4]=[c5]_布林值是1*2=2,[f4]=[c6]是0*3=0,結果值是2
   '[f4]=[c4]_其布林值是0,[f4]=[c5]_布林值是0*2=0,[f4]=[c6]是1*3=3,結果值是3
   If j * k Then [f9].Cells(j + k - 1) = [f5]
   '↑如果j變數*k變數不是 0,就令[f9]相對位置儲存格值是 [f5]
End With
End Sub
絕對值括弧裡的值看起來都是正數,雖然尚不了解為何要加Abs,後學如果知道了會回來補充
謝謝前輩

作者: bhsm 時間: 2023-4-24 15:18

回復 27# Andy2483
感謝Andy2483大加上中文註解

作者: 准提部林 時間: 2023-4-25 14:02

回復 27# Andy2483

VBA中的 True 填為 -1, 與公式中的 1 不同

作者: Andy2483 時間: 2023-4-25 14:59

本帖最後由 Andy2483 於 2023-4-25 15:01 編輯

回復 29# 准提部林

謝謝前輩指導
這問題應該是VBA的基礎,後學不求甚解,一直錯誤認知中學習,謝謝前輩的提攜

Sub TEST()
MsgBox ([A1] = [A1]) + ([B1] = [B1])
End Sub

執行結果:
[attach]36221[/attach]

============================================
Sub TEST_1()
MsgBox ([A1] <> [A1]) + ([B1] <> [B1])
End Sub
結果值是 0

作者: 准提部林 時間: 2023-4-25 17:02

回復 30# Andy2483

MsgBox (1 = 1) + (2 = 2)

我這 = -2

作者: Andy2483 時間: 2023-4-26 07:21

回復 31# 准提部林

謝謝前輩
瞭解了

Sub TEST()
MsgBox ([A1] = [A1]) + ([B1] = [B1])
End Sub
結果值是 -2

Sub TEST_1()
MsgBox ([A1] <> [A1]) + ([B1] <> [B1])
End Sub
結果值是 0

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)