中心通过缩进

时间:2016-07-01 20:08:00

标签: excel excel-vba number-formatting conditional-formatting vba

我有长期格式化的挫败感。我经常手动执行此操作,但手动执行此操作需要永远,并且必须有一种方法可以使用VBA宏,条件格式或聪明的数字格式。

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

  1. 列中的最大数字(在本例中为列中的最后一个数字,$ 103,420)在单元格中居中。
  2. 但是,单元格中的最大数字不是居中对齐的,而是右对齐,直到值居中为止。
  3. 列中的所有其他数字也正确缩进相等的数量。这是可取的,因为它排列了每个数字中的位置,十位等。
  4. 用括号括起来表示负数。
  5. 美元符号与最左边的数字相邻。
  6. 对于大于999的数字,正确包含逗号。
  7. 这个结果是通过以下方式实现的:

    1. 应用以下数字格式:$#,##0_);($#,##0)_);$0_);@_)
    2. 在最大数字上手动调整单元格的右缩进,以确定它何时大致居中。如果一侧或另一侧必须有更多空间,则数字左侧留有较大的空间。
    3. Desired Result

      我尝试应用与回复this question.时使用的数字格式相似的数字格式 具体来说,我尝试使用它是使用以下数字格式对齐所有单元格:$?,??0;($?,??0);

      这会产生以下结果,但不会产生以下结果。

      enter image description here

      关于如何解决这个问题的想法?我正在想象一个宏,它标识选择中的最大数字,获取该数字中的位数,字体大小,列的宽度,做一些计算产生所需的右缩进,然后应用右缩进。我只是不确定如何进行这种计算。

2 个答案:

答案 0 :(得分:0)

'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

答案 1 :(得分:0)

克里斯 - 你的答案并没有做我希望的事情(你的答案在美元符号和最后一个数字之间留出空间,数字比数字中最长的数字短)< / p>

但是,您的代码是我提出的解决方案的有用起点。结果如下图所示,以及该解决方案的固有缺点 - 在以这种方式格式化之后对列中的数字运行公式会产生奇怪的数字格式。

我能想出的唯一解决方案是解决此解决方案所遇到的问题,即依赖于估算缩进并应用它的问题。只有在未调整列宽的情况下,该解决方案才有效。如果调整它,则必须重新运行宏。另外,因为缩进只能增加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

解决方案显示了下面显示的解决方案的缺点。

enter image description here