我有长期格式化的挫败感。我经常手动执行此操作,但手动执行此操作需要永远,并且必须有一种方法可以使用VBA宏,条件格式或聪明的数字格式。
以下是我想要的结果。它具有以下属性:
这个结果是通过以下方式实现的:
$#,##0_);($#,##0)_);$0_);@_)
我尝试应用与回复this question.时使用的数字格式相似的数字格式
具体来说,我尝试使用它是使用以下数字格式对齐所有单元格:$?,??0;($?,??0);
这会产生以下结果,但不会产生以下结果。
关于如何解决这个问题的想法?我正在想象一个宏,它标识选择中的最大数字,获取该数字中的位数,字体大小,列的宽度,做一些计算产生所需的右缩进,然后应用右缩进。我只是不确定如何进行这种计算。
答案 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
解决方案显示了下面显示的解决方案的缺点。