VBA 根据值更改单元格格式

Question

我想知道如何使用 VBA 自动格式化输入值的单元格。我实际上将数字分为 3 类：百分比、小数字（-1000 - 1000）和大数字。

我希望以 2 位小数和 % 符号显示百分比。 小数也有 2 位小数。 大数字四舍五入到最接近的 integer，有数千个分隔符。

我有 VBA 中的条件，但是如果单元格值发生变化，我希望代码重新格式化单元格，并且知道如何做到这一点。 例如，如果我将一个值为“50,000”的单元格更改为 60%，那么它应该显示为“60.00%”。 到目前为止，我所拥有的是对现有单元格值应用格式的代码。

 Sub myNumberFormat() Dim cel As Range Dim selectedRange As Range Set selectedRange = Selection For Each cel In selectedRange.Cells If Not CStr(cel.Text) Like "*%*" Then If Not IsEmpty(cel) Then If cel.Value < 1000 And cel.Value > -1000 Then cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)" Else cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)" End If End If Else cel.NumberFormat = "0.00%" End If Next cel End Sub

如果这是最好的代码，我也知道。 我是 VBA 的新手，我主要在谷歌上搜索点点滴滴。 非常感谢一些帮助和提示，因为我厌倦了格式化东西:)。 谢谢

Answer 1

工作表更改：应用单元格格式

• 这是一个单列的简单示例，在这种特殊情况下，范围是从A2到列A中最底部的单元格。 但是您可以选择任何合理的单元格地址。 在您手动更改（输入、复制/粘贴或使用 VBA 写入）其值的任何单元格中，该单元格将根据您的“重新排列”过程ApplyMySpecialNumberFormat进行格式化。
• 请注意，这会自动工作，只需将代码复制到相应的模块并开始将数据输入到范围的单元格中以查看它的工作原理。

工作表模块，例如Sheet1

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) ' Define constants. Const FirstCellAddress As String = "A2" ' adjust to any reasonable cell ' Reference the source column range eg 'A2:ALastWorksheetRow'. Dim srg As Range ' With Me.Range(FirstCellAddress) Set srg =.Resize(Me.Rows.Count -.Row + 1) End With ' Reference the cells of the source range that have changed. Dim irg As Range: Set irg = Intersect(srg, Target) If irg Is Nothing Then Exit Sub ' no source range cells changed; exit ' At least one cell was changed: ApplyMySpecialNumberFormat irg End Sub

标准模块，例如Module1

 Option Explicit Sub ApplyMySpecialNumberFormat(ByVal rg As Range) Dim cel As Range For Each cel In rg.Cells If CStr(cel.Text) Like "*%*" Then cel.NumberFormat = "0.00%" Else If VarType(cel) = vbDouble Then ' is a number If cel.Value < 1000 And cel.Value > -1000 Then cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)" Else cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)" End If End If End If Next cel End Sub