インデントで選択範囲の中で最大の番号を整列する

Question

私は長年にわたり定型的な欲求不満を持っています。私は手動でこれを行うことがよくありますが、手動で行うには永遠にかかるので、VBAマクロ、条件付き書式または巧妙な数値書式のいずれかでこれを行う方法が必要です。

以下は私が望む結果です。

1. 列内の最大数（この場合、列の最後の数値、$ 103,420）は、セルの中央に配置されています。
2. セル内の最大の数値は中央揃えではなく、値が中央揃えされるまで右インデントされます。
3. 列内の他の数字もすべて同じ量だけインデントされます。これは、それぞれの数字に1位、10位などを並べるので望ましい。
4. 負の数はカッコで囲んで示しています。
5. ドル記号は左端の数字に隣接しています。手動$#,##0_);($#,##0)_);$0_);@_)
6. 上のセルの右インデントを調整する次の数値形式を適用
   1. ：
   2. カンマは、この結果は、によって達成された999

   より大きい数に対して適切に含まれていますおおよそ中央に位置するときを決定する最大の数。一方または他方のスペースがさらに必要な場合は、番号の左側に大きなスペースが残ります。

私は具体的にこれを使用しての私の試みは、次の番号の形式を使用してすべてのセルを中央揃えすることでしたthis question. に応じて使用されているものと同様の数値形式を適用しようとした：$?,??0;($?,??0);

これは以下のような近い結果をもたらしますが、下の結果はそれほどありません。私はこの問題に対処する方法の

思考？私は選択の中で最大の数字を特定し、その数字の桁数、フォントサイズ、列の幅を取得するマクロを想像しています。いくつかの計算では、適切なインデントを生成してから、正しいインデントを適用します。私はそのような計算をどうやって行うのか分かりません。あなたの答えは私が期待していた何をしません（あなたの答えはドル記号とセットで最長の数よりも短い数字のための「最後」の数字の間にスペースを残します）

-

Answer 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 

ソリューションは、以下に示すソリューションの欠点を視覚化しています。

Answer 2

'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