返回列表 上一主題 發帖

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

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

請教達人:
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)
年齡不小,但我很想學

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
試一下看看

TOP

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

1.rar (11.45 KB)

年齡不小,但我很想學

TOP

回復 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 的值來分別處理不同的情況。另外,您也可以考慮使用資料驗證功能來建立下拉式清單,這樣可能會更簡單一些。

TOP

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

回復 1# bhsm


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

執行前:
20230410_1.jpg
2023-4-10 09:33


[F4]輸入7 執行結果:
20230410_2.jpg
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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

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

1-1.rar (11.51 KB)

年齡不小,但我很想學

TOP

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

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

A.rar (12.23 KB)

年齡不小,但我很想學

TOP

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

20230410_3.jpg
2023-4-10 13:44


PS:5樓方案的VBA程式碼需刪除
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

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

TOP

本帖最後由 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

        靜思自在 : 人要自愛,才能愛普天下的人。
返回列表 上一主題