[發問] 選擇下拉式清單自動填入

bhsm

請教達人:
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或函數如何寫?
新增 Microsoft Excel 工作表.rar (6.08 KB)

下載次數: 6

2023-4-8 16:39

sillykin

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

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

sillykin

回復 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

回復 1# bhsm


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

執行前:

下載 (35.86 KB)

2023-4-10 09:33

[F4]輸入7 執行結果:

下載 (34.89 KB)

2023-4-10 09:33

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

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

bhsm

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

Andy2483

回復 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,""),"")

下載 (67.15 KB)

2023-4-10 13:44

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

bhsm

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

Andy2483

回復 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