在下拉列表中处理更长的值

时间:2012-08-27 19:11:34

标签: vba excel-vba excel

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

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

感谢任何建议

1 个答案:

答案 0 :(得分:0)

我不知道这种行为是否符合您的要求,但这可以让您了解可能的行为

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