使用資料>驗證>儲存格的下拉式清單，可以讓下拉顯示窗格增加列數嗎?

返回列表下一主題上一主題發帖

HUNGCHILIN

　暱稱: 阿吉
　頭銜: 不恥下問,不斷學習,才會進步

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 647
主題: 190
精華: 24
積分: 1037
點名: 0
作業系統: windows7
軟體版本: Office 2010 ; OOO3.0 ; Google
閱讀權限: 100
性別: 男
來自: 竹南
註冊時間: 2010-5-2
最後登錄: 2022-6-24

貴賓勳章熱烈參與勳章好學求知勳章

1^# 跳轉到 »

發表於 2010-12-11 15:58 | 顯示全部帖子

本帖最後由 Hsieh 於 2010-12-12 23:49 編輯

回復 1# sasser
基本上這一帖以前在EXCELHELP 上有人發表過
但目前EXCELHELP以已關版

我將文章貼在這HUNGCHILIN
檔案連結也沒有了無法下載

使用下列程式 COPY 後貼到這個檔案中的 THISWORKBOOK 程式區內就可以使用了
----------------------------------------------------------------------------------------
加長驗證的長度及寬度　

這篇關於驗證的文章對於驗證有很大的幫助
可以突破excel限制使驗證清單拉長會比較方便

轉貼給各位參考

Option Explicit
Dim oDpd As Object
Dim sFml1
Dim prvTarget As Range
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const dFixedPos As Double = "0.8"
Const dFixWidth As Double = "16" ' 改變 DropDown 的寬度
Dim vld As Validation
Dim lDpdLine As Long
If Not prvTarget Is Nothing Then
If Not oDpd Is Nothing Then
If oDpd.value = 0 Then
prvTarget.value = vbNullString
Else
prvTarget.value = Range(Mid(sFml1, 2)).Item(oDpd.value)
End If
Set prvTarget = Nothing
End If
End If
On Error Resume Next
oDpd.Delete
sFml1 = vbNullString
Set oDpd = Nothing
On Error GoTo 0
If Target.Count > 1 Then
Set oDpd = Nothing
Exit Sub
End If
Set vld = Target.Validation
On Error GoTo Terminate
sFml1 = vld.formula1
On Error GoTo 0
Set prvTarget = Target
lDpdLine = Range(Mid(sFml1, 2)).Rows.Count
With Target
Set oDpd = ActiveSheet.DropDowns.Add( _
.Left - dFixedPos, _
.Top - dFixedPos, _
.Width + dFixWidth + dFixedPos * 2, _
.Height + dFixedPos * 2)
End With
With oDpd
.ListFillRange = sFml1
.DropDownLines = lDpdLine
.Display3DShading = True
End With
Terminate:
End Sub