问缩进选择中的中心对齐最大数
EN

Stack Overflow用户

提问于 2016-07-01 12:08:00

回答 2查看 96关注 0票数 0

我有一个长期的格式挫折。我经常手动这样做，但手动操作需要花费很长时间，而且必须有一种方法可以用VBA宏、条件格式或巧妙的数字格式来完成。

下面是我想要的结果。它具有以下属性：

列中的最大数字(在本例中是列中的最后一个数字，$103,420)集中在单元格内。
然而，单元格中最大的数字不是对齐的，它是正确缩进的，直到值被居中为止。
列中的所有其他数字也是对的，缩进的数量相等。这是可取的，因为它排列了一个位置，十位等在每一个数字。
负数用括号表示。
美元符号与最左边的数字相邻。
对于大于999的数字，适当地包括逗号。

取得这一成果的途径是：

应用下列数字格式：$#,##0_);($#,##0)_);$0_);@_)
手动调整最大数字上单元格的右缩进，以确定它何时大致居中。如果其中一方必须有更多的空间，则在数字的左边留下较大的空间。

我试图应用一种类似于响应this question.的数字格式，具体而言，我使用它的尝试是使用以下数字格式对齐所有单元格：$?,??0;($?,??0);

这将产生下面的关闭结果，但不完全是下面的结果。

关于我如何解决这个问题的想法？我在想象一个宏，它识别所选内容中最大的数字，获取该数字中的数字数，字体大小，列的宽度，进行一些计算，生成所需的右缩进，然后应用右缩进。我只是不知道该怎么做那种计算。

conditional-formatting

vba

excel

number-formatting

回答 2

Stack Overflow用户

回答已采纳

发布于 2016-07-02 18:38:22

克里斯-你的答案没有达到我的期望(你的答案在美元符号和“最后”数字之间留出了空间，因为数字比集合中最长的数字要短)

但是，您的代码是我想出的解决方案的一个有用的起点。结果显示在下面的图像中，以及这个解决方案的固有缺点--在列中的数字被格式化后，运行一个公式就会产生一个奇怪的数字格式。

我能想出的唯一解决方案没有这个解决方案的问题，那就是依赖于估计一个缩进，并应用它。该解决方案只有在列宽不向前调整的情况下才能工作。如果对其进行调整，则必须重新运行宏。此外，由于缩进只能增加1(且不少于1)，应用缩进的宏通常会导致列中的最大数字不精确地居中。这不是什么大不了的事，但我目前的解决方案没有这些问题，在我的用例中，这些格式是格式化电子表格过程中的最后一步，所以不太可能发生额外的计算，如果有，宏就可以根据需要重新运行。

'Select your data range, and run formatCells_Accounting().  The number formatting in the selected cells will widen to the cell with the longest value.  Note, the macro does not work on values greater than 10^14 (not sure why.)
Sub formatCells_Accounting()
    Dim rg, thisColRange, rCell As Range
    Dim maxVal, minVal, valueLen, longest_, lenLongest As Long

    Set rg = Selection

    'Center aligns all selected cells
    rg.HorizontalAlignment = xlCenter

    'Loops through each column in the selected range so that each column can have it's own max value
    For Each thisColRange In rg.Columns

        maxVal = Application.WorksheetFunction.Max(thisColRange)
        minVal = Application.WorksheetFunction.Min(thisColRange)

        'The longest number in the range may be the most negative
        'This if section accounts for this scenario
        If Abs(minVal) > maxVal Then
            longest_ = minVal
        Else
            longest_ = maxVal
        End If

        'Gets the length of the longest value rounded to the ones place (aka length not including decimals)
        lenLongest = Len(CStr(Round(Abs(longest_), 0)))

        'Creates a number format for every cell
        For Each rCell In thisColRange.Cells
            'Gets the length of the value in the current cell
            valueLen = Len(CStr(Round(Abs(rCell.Value), 0)))
            rCell.NumberFormat = "_(" & addCommasDollarsToFormat(lenLongest, valueLen, rCell.Value) & "_);" & _
                                 "_(" & addCommasDollarsToFormat(lenLongest, valueLen, rCell.Value) & ")_);" & _
                                 "_(" & Left(addCommasDollarsToFormat(lenLongest, 1, rCell.Value), Len(addCommasDollarsToFormat(lenLongest, 1, rCell.Value)) - 1) & "0_);" & _
                                 "_(@_)"
        Next
    Next

End Sub

Function addCommasDollarsToFormat(ByVal lenLongest, ByVal valueLen, ByVal cellVal) As String

    Dim new_str_ As String
    Dim i, j As Long

    'Initializes empty strings
    new_str_ = ""
    nearlyFinishedString = ""

    'Adds ? and , through the length of the value currently being formatted
    For i = 1 To valueLen
        If i Mod 3 = 1 And i <> 1 Then
            new_str_ = new_str_ & ",?"
        Else
            new_str_ = new_str_ & "?"
        End If
    Next

    If cellVal < 0 Then
        new_str_ = new_str_ & "$("
    Else
        new_str_ = new_str_ & "$"
    End If

    For j = i To lenLongest
        If j Mod 3 = 1 Then
            new_str_ = new_str_ & ",?"
        Else
            new_str_ = new_str_ & "?"
        End If
    Next

    addCommasDollarsToFormat = StrReverse(new_str_)

End Function

解决方案可视化与下面显示的解决方案的缺点。

票数 0

Stack Overflow用户

发布于 2016-07-01 20:52:22

'Select your data range, and run formatCells_Accounting().  The number formatting in the selected cells will widen to the cell with the longest value.  Note, the macro does not work on values greater than 10^14 (not sure why.)

Sub formatCells_Accounting()
Dim rg As Range
Set rg = Selection

maxVal = Application.WorksheetFunction.Max(rg)
minVal = Application.WorksheetFunction.Min(rg)

If Abs(minVal) > maxVal Then
    longest_ = minVal
Else
    longest_ = maxVal
End If

lenLongest = Len(CStr(Round(longest_, 0)))

rg.NumberFormat = "_($" & addCommasToFormat(lenLongest) & "_);" & _
                  "_(($" & addCommasToFormat(lenLongest) & ");" & _
                  "_($" & addCommasToFormat(lenLongest - 1) & "0_);" & _
                  "_(@_)"


End Sub

Function addCommasToFormat(ByVal lenLongest) As String
    str_ = String(lenLongest, "?")
    new_str_ = ""

    For i = 1 To Len(str_)
        If i Mod 3 = 1 And i <> 1 Then
            new_str_ = new_str_ & ",?"
        Else
            new_str_ = new_str_ & "?"
        End If
    Next

    addCommasToFormat = StrReverse(new_str_)
End Function