vba - 处理下拉列表中较长的值

Question

我有一个 excel 形式的下拉列表，由于下拉列表的长度限制，其中的值不适合单行。有解决方案吗？

我可以增加下拉列表的宽度并在两行而不是一行中显示更长的值吗？

任何建议表示赞赏

Answer 1

我不知道这种行为是否是您想要的，但这可以让您了解可能的情况

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