Question

首先，下面按预期工作。我试图让宏模仿我们的话。我们的单词宏将选择整个列，只显示当前正在处理的列（选择对象不用于任何实际处理）。

在excel中，当我尝试选择列（activecell.entirecolumn.select）时，如果有合并的单元格，它将显示多个列。我只需要选择活动单元格中的字母列（与单击顶部的字母几乎相同）。我希望有一种方法，如果可能的话，不需要我解析单元格的地址（我觉得字符串解析很邋））。

Sub setwidths()
Dim rangeName As String
Dim selectedRange As range
Dim tempRange As range
Dim x As Integer

'If only 1 cell is selected, attempt to find the correct named range
If Selection.Cells.Count = 1 Then 
    rangeName = Lib.getNamedRange(Selection) 'Built in function from my lib (works I promise)

    If rangeName <> "" Then
        Application.Goto reference:=rangeName
    End If
End If

Set selectedRange = Selection

'Go column by column asking for the width
'Made to mimic a word MACRO's behavior and moving backwards served a point in word
For x = selectedRange.Columns.Count To 1 Step -1
    Set tempRange = selectedRange.Columns(x)
    tempRange.Cells(tempRange.Cells.Count, 1).Select
'This is where the code should go to select the column
    tempRange.ColumnWidth = InputBox("This columns?")
Next
End Sub

无论如何都要从活动单元格中逐字逐句地选择（范围（＆＃34; A：A＆＃34;）。例如选择）？

编辑：记录MACRO显示单击顶部字母时使用的列（＆＃34; A：A＆＃34;。）。但是，将相同的行输入到即时窗口中将选择合并单元格与范围相同的所有列（＆＃34; A：A＆＃34;）。select和activecell.selectcolumn

Sub NSTableAdjust()
Dim rangeName As String
Dim selectedRange As range
Dim tempRange As range
Dim cellsColor() As Long
Dim cellsPattern() As XlPattern
Dim cellsTaS() As Long
Dim cellsPTaS() As Long
Dim result As String
Dim abort As Boolean

Dim x As Integer
Dim y As Integer

'Delete the block between these comments and run macro on 10x10 grid in excel to test
If Selection.Cells.Count = 1 Then
    rangeName = Lib.getNamedRange(Selection)

    If rangeName <> "" Then
        Application.Goto reference:=rangeName
    End If
End If
'Delete the block between these comments and run macro on 10x10 grid in excel to test

Set selectedRange = Selection
ReDim cellsArr(1 To selectedRange.Rows.Count)
ReDim cellsColor(1 To UBound(cellsArr))
ReDim cellsPattern(1 To UBound(cellsArr))
ReDim cellsTaS(1 To UBound(cellsArr))
ReDim cellsPTaS(1 To UBound(cellsArr))
abort = False

For x = selectedRange.Columns.Count To 1 Step -1
    Set tempRange = selectedRange.Columns(x)
    tempRange.Cells(tempRange.Cells.Count, 1).Select

    For y = 1 To UBound(cellsColor)
        With tempRange.Cells(y, 1).Interior
            cellsColor(y) = .Color
            cellsPattern(y) = .Pattern
            cellsTaS(y) = .TintAndShade
            cellsPTaS(y) = .PatternTintAndShade
            .Color = 14136213
        End With
    Next

    result = InputBox("This Column?")

    If IsNumeric(result) Then
        tempRange.ColumnWidth = result
    Else
        abort = True
    End If

    For y = 1 To UBound(cellsColor)
        With tempRange.Cells(y, 1).Interior
            .Color = cellsColor(y)
            .Pattern = cellsPattern(y)
            .TintAndShade = cellsTaS(y)
            .PatternTintAndShade = cellsPTaS(y)
        End With
    Next

    If abort Then
        Exit Sub
    End If
Next
End Sub

我目前的解决方案是简单地遮蔽细胞，然后在处理色谱柱后恢复原始阴影。

Answer 1

在对帖子的评论中进行了明显冗长的讨论。我的问题的答案似乎只是“不可能”。

我试图接近我正在搜索的“Look”的解决方案如下：

For x = selectedRange.Columns.Count To 1 Step -1
    Set tempRange = selectedRange.Columns(x) 'Range of the column

    'Our standards dictate the last cell in the range will not be merged
    With tempRange.Cells(tempRange.Cells.Count, 1) 
        .Select 'Selecting here will for excel to make sure the range is in view
        'Very simple/basic conditional formatting rule
        Set fCondition = .EntireColumn.FormatConditions. _
            Add(Type:=xlExpression, Formula1:="=True")
            fCondition.Interior.Color = 15123099
        'Make sure it is the highest priority rule
        fCondition.Priority = 1
    End With

    'Get user input
    result = InputBox("This Column?")

    'Delete rule
    fCondition.Delete

    'Validate user input
    If IsNumeric(result) Then
        tempRange.ColumnWidth = result
    Else
        abort = True
    End If

    If abort Then
        Exit Sub
    End If
Next

从activeCell中逐字逐句选择（不带activeCell.EntireColumn）

1 个答案: