返回列表 上一主題 發帖

[發問] 如何讓下拉選單選取後自動跳到儲存格相對應處?

回復 10# c_c_lai

謝謝你提供那麼詳細的說明

我的EXCEL開啟(安全同意也開啟)也依照畫面步驟去點選A2,可是沒有出現下拉表,是否我缺少什麼物件

Y+.jpg
2013-11-6 10:36
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 10# c_c_lai

我的EXCEL是2007
開啟你的檔案,其工作表名稱是 Sheet1、 Sheet2、 Sheet3
但VBA程式中用的工作表名稱是 工作表1、工作表2
我試著將 VBA中的 "工作表" 改為 "Sheet" 也不行
該如何是好  

例如
Sub CellValidation()      '  stillfish00 提供
    With Sheets("工作表2").[A2:A25].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=工作表1!$A$3:$A$20"
    End With
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復  c_c_lai

我的EXCEL是2007
開啟你的檔案,其工作表名稱是 Sheet1、 Sheet2、 Sheet3
但VBA程式中 ...
ML089 發表於 2013-11-6 10:49

之前我是另外新增一Excel檔案測試,完成後便直接將程式碼貼入到原本的
"相片輸出價目表.xlsm" 內,忘了將其對應的表單名稱一併修正,真是對不起!
相片輸出價目表.rar (24.83 KB)

TOP

回復 12# ML089
你再試試看,測試結果如何再行告訴我。
謝謝!

TOP

回復 14# c_c_lai

還是不行,按A2、A3...都沒有反應
之前樓主的檔案也不行,後來我自行設定 資料驗證(清單) ,下拉選單才出現

請問 ComboBox1 是否需要自行增設,還是程式已經內定就有
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復  c_c_lai

還是不行,按A2、A3...都沒有反應
之前樓主的檔案也不行,後來我自行設定 資料驗證(清單 ...
ML089 發表於 2013-11-6 12:47

請問你是下載 "相片輸出價目表.xlsm" 直接用它來測試,還是
自己另外開啟一新檔案,而僅複製程式碼來運作?

TOP

回復 16# c_c_lai


我也是耶,直接開啟下載的檔案,然後點了A2就出現錯誤訊息了,
二個檔案都一樣。
2013-11-06_131256.jpg

TOP

回復 17# owen06
請你直接開啟 #1 的附件,然後將以下程式碼貼入到 Sheet2 的程式碼區再試試看  (完全複製過去),
結果如何請回復告知,謝謝! (我這邊無論是另行新增、或者是使用 #1 的附件都是OK的 )
  1. Public ckCurr As Boolean

  2. Private Sub ComboBox1_Change()    '  stillfish00 提供
  3.     If ckCurr Then Exit Sub
  4.    
  5.     Application.EnableEvents = False
  6.    
  7.     ckCurr = False
  8.     ComboBox1.Visible = False
  9.     Range(ComboBox1.LinkedCell).Offset(, 2).Select
  10.     Application.EnableEvents = True
  11. End Sub

  12. Private Sub CommandButton1_Click()
  13.     If Me.ComboBox1.Visible Then ckCurr = True: Me.ComboBox1.Visible = False
  14.    
  15.     Range("A2:A25,C2:C25").Select
  16.     Selection.ClearContents
  17. End Sub

  18. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  19.     Dim StrVdFml As String
  20.    
  21.     '  If ckCurr Then Exit Sub
  22.     On Error Resume Next
  23.         StrVdFml = Replace(ActiveCell.Validation.Formula1, "=", "")
  24.         '  ActiveCell.Validation.Formula1 :  "=Sheet1!$A$3:$A$20"
  25.         '  ComboBox1.ListFillRange        :   Sheet1!$A$3:$A$20
  26.         '  Replace(ActiveCell.Validation.Formula1, "=", "") : "Sheet1!$A$3:$A$20"
  27.         '  StrVdFml : "Sheet1!$A$3:$A$20"
  28.         ActiveCell.Validation.InCellDropdown = False
  29.     On Error GoTo 0
  30.     If StrVdFml = "" Then
  31.         If Me.ComboBox1.Visible Then Me.ComboBox1.Visible = False
  32.     Else
  33.         With Me.ComboBox1
  34.             '  ComboBox1.progID   =EMBED("Forms.ComboBox.1","")
  35.             '  ComboBox1:        ComboBox
  36.             '  LinkedCell:       $A$2
  37.             '  ListFillRange :   Sheet1!$A$3:$A$20
  38.             .Left = ActiveCell.Left
  39.             .Top = ActiveCell.Top
  40.             '  .Width = ActiveCell.Width + 140
  41.             .Width = ActiveCell.Width
  42.             '  .Height = ActiveCell.Height + 10
  43.             .Height = ActiveCell.Height
  44.             '  .Font.Size = 22
  45.             .Font.Size = 12

  46.             .LinkedCell = ActiveCell.Address    '  "$A$2"
  47.             .ListFillRange = StrVdFml           '  "Sheet1!$A$3:$A$20"
  48.             .Visible = 1                        '  顯示下拉符號

  49.             .Object.SpecialEffect = 3
  50.             '.Object.Font.Size = ActiveCell.Font.Size
  51.         End With
  52.     End If
  53.   
  54.     ckCurr = False
  55. End Sub

  56. Private Sub Worksheet_Change(ByVal Target As Range)
  57.     '  Target.Font.ColorIndex = 5
  58.    
  59.     If Not Intersect(Target, Range("C2:C25")) Is Nothing Then
  60.         If Target(1, 1) = 0 Then Exit Sub
  61.         ckCurr = True
  62.         '  MsgBox Target.Address
  63.         Target.Offset(1, -2).Select
  64.     End If
  65. End Sub

  66. Sub CellValidation()      '  stillfish00 提供
  67.     With Sheets("Sheet2").[A2:A25].Validation
  68.         .Delete
  69.         .Add Type:=xlValidateList, Formula1:="=Sheet1!$A$3:$A$20"
  70.     End With
  71. End Sub
複製代碼

TOP

回復 18# c_c_lai


開啟 #1 的附件,然後將程式碼貼入到 Sheet2 的程式碼區,還是不行

自行設定 資料驗證 後,是可以執行,下拉選單 - 選完自動跳到 C欄數量 - 輸入數量也自動跳到下一列。
可是下拉選單又好像不是 資料驗證的下拉選單,應該是ComboBox1得下拉選單

我自己用資料驗證配合Worksheet_Change也可以達到效果,只是資料驗證選單功能比較陽春。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Target.Offset(, 2).Select
    ElseIf Target.Column = 3 Then
        Target.Offset(1, -2).Select
    End If
End Sub

相片輸出價目表_ML089.rar (31.27 KB)
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 19# ML089
再試試看 (有整理過)
08.png
2013-11-6 15:48

相片輸出價目表_ML089.rar (24.95 KB)

TOP

        靜思自在 : 【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
返回列表 上一主題