- 帖子
- 710
- 主題
- 280
- 精華
- 0
- 積分
- 1016
- 點名
- 0
- 作業系統
- Windows 10
- 軟體版本
- Office 2019
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-6-30
- 最後登錄
- 2025-1-19
|
如何改寫
- Public ckCurr As Boolean
- Private Sub XXXXComboBox1_Change() ' stillfish00 提供
- If ckCurr Then Exit Sub
-
- Application.EnableEvents = False
-
- ckCurr = False
- ComboBox1.Visible = False
- Range(ComboBox1.LinkedCell).Offset(, 2).Select
- Application.EnableEvents = True
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim StrVdFml As String
-
- ' If ckCurr Then Exit Sub
- On Error Resume Next
- StrVdFml = Replace(ActiveCell.Validation.Formula1, "=", "")
- ' ActiveCell.Validation.Formula1 : "=工作表1!$A$3:$A$20"
- ' ComboBox1.ListFillRange : 工作表1!$A$3:$A$20
- ' Replace(ActiveCell.Validation.Formula1, "=", "") : "工作表1!$A$3:$A$20"
- ' StrVdFml : "工作表1!$A$3:$A$20"
- ActiveCell.Validation.InCellDropdown = False
- On Error GoTo 0
- If StrVdFml = "" Then
- If Me.ComboBox1.Visible Then Me.ComboBox1.Visible = False
- Else
- With Me.ComboBox1
- ' ComboBox1.progID =EMBED("Forms.ComboBox.1","")
- ' ComboBox1: ComboBox
- ' LinkedCell: $A$2
- ' ListFillRange : 工作表1!$A$3:$A$20
- .Left = ActiveCell.Left
- .Top = ActiveCell.Top
- ' .Width = ActiveCell.Width + 140
- .Width = ActiveCell.Width + 80
- ' .Height = ActiveCell.Height + 10
- .Height = ActiveCell.Height + 5
- ' .Font.Size = 22
- .Font.Size = 16
- .LinkedCell = ActiveCell.Address ' "$A$2"
- .ListFillRange = StrVdFml ' "工作表1!$A$3:$A$20"
- .Visible = 1 ' 顯示下拉符號
- .Object.SpecialEffect = 3
- '.Object.Font.Size = ActiveCell.Font.Size
- End With
- End If
-
- ckCurr = False
- End Sub
- Sub CellValidation() ' stillfish00 提供
- With Sheets("工作表1").[B2:B200].Validation
- .Delete
- .Add Type:=xlValidateList, Formula1:="=工作表2!$C$2:$C$200"
- End With
- End Sub
複製代碼 原功能:
點工作表1的B2時,會顯示工作表2的B2:B200的資料
改成:
點工作表1的C2時,會顯示工作表2的C2:C200的資料
所以我將B2:B200這段改成C2:C200~更改失敗~無資料 |
|