处理下拉列表中较长的值



我有一个excel形式的下拉列表,由于下拉列表的长度限制,其中的值不能放在一行中。有解决方案吗?

我可以增加下拉列表的宽度,用两行而不是一行显示更长的值吗?

任何建议都欢迎

我不知道行为是否是你想要的,但这给出了的可能性

Option Explicit
Dim origColWidth As Double
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const avgcharperStdColumn As Long = 8 'avg characters in col width 8.43
Const defaultColumnWidth As Double = 8.43 'Default column width
Dim dataValCell As Range
Dim cellVal As Validation
Dim splitString() As String
Dim newColWidth As Double
Dim i As Long
Dim maxStrLength As Long

    'Set cell with data validation
    Set dataValCell = Sheet1.Range("G5") 'Define which cell contains validation
    'Check selection intersects required cell
    'Also check only 1 cell is selected
    If Not Intersect(Target, dataValCell) Is Nothing _
        And Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        'capture current width to allow reset
        origColWidth = Target.ColumnWidth
        'access the validation list in the cell
        Set cellVal = dataValCell.Validation
        'Split the contents into an array and cycle to find longest string
        splitString = Split(cellVal.Formula1, ",")
        For i = LBound(splitString) To UBound(splitString)
            If Len(splitString(i)) > maxStrLength Then maxStrLength = Len(splitString(i))
        Next i
        'VERY crude method to calc how many chars fit column - needs more work :)
        newColWidth = (maxStrLength / avgcharperStdColumn) * defaultColumnWidth
        If newColWidth > origColWidth Then
            dataValCell.ColumnWidth = newColWidth
        End If
    'if variable set and not intersecting validation cell then reset column width
    ElseIf origColWidth > 0 Then
        dataValCell.ColumnWidth = origColWidth
    End If
End Sub

最新更新