下面是一段格式化脚本

vba
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'    ' 错误处理，避免意外错误导致程序中断
'    On Error GoTo ErrorHandler
'
'    ' 只处理单个单元格的选择
'    If Target.CountLarge > 1 Then Exit Sub
'
'    ' 只处理包含数字值的单元格
'    If IsNumeric(Target.Value) And Not IsEmpty(Target) Then
'        ' 禁用屏幕更新和事件触发，提高性能并防止递归
'        Application.EnableEvents = False
'        Application.ScreenUpdating = False
'
'        ' 获取原始值并转换为字符串
'        Dim originalValue As String
'        originalValue = CStr(Target.Value)
'
'        ' 查找小数点的位置
'        Dim decimalPosition As Integer
'        decimalPosition = InStr(originalValue, ".")
'
'        If decimalPosition > 0 Then
'            ' 如果存在小数点且小数点后位数超过2位
'            If Len(originalValue) - decimalPosition > 2 Then
'                ' 直接截取到小数点后两位（不做四舍五入）
'                Target.Value = Left(originalValue, decimalPosition + 2)
'            End If
'        End If
'
'        ' 无论是否截断，都格式化为两位小数显示
'        Target.NumberFormat = "0.00"
'
'    End If
'
'ExitHandler:
'    ' 恢复设置
'    Application.EnableEvents = True
'    Application.ScreenUpdating = True
'    Exit Sub
'
'ErrorHandler:
'    ' 发生错误时也恢复设置
'    Resume ExitHandler
'End Sub




Sub FormatChemicalComposition()
    Dim selectedRange As Range
    Dim dataRange As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim colIndex As Integer
    Dim cellValue As Variant
    Dim decimalPlaces As Integer
    Dim tempArray As Variant
    
    ' 获取当前选中的行范围
    Set selectedRange = Selection
    If selectedRange Is Nothing Then Exit Sub
    
    ' 获取工作表的最后一行
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
    ' 确定要处理的D-M列范围（只处理选中行对应的D-M列）
    Set dataRange = Range("D" & selectedRange.Row & ":M" & selectedRange.Row + selectedRange.Rows.Count - 1)
    
    ' 将数据读取到数组中进行批量处理（提高效率）
    tempArray = dataRange.Value
    
    ' 禁用屏幕更新和自动计算
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 设置整个区域为文本格式（防止0.20显示为0.2）
    dataRange.NumberFormat = "@"
    
    ' 批量处理数组中的数据
    For i = 1 To UBound(tempArray, 1)
        For j = 1 To UBound(tempArray, 2)
            colIndex = j + 3 ' D列是第4列，所以j=1对应D列，j=2对应E列，以此类推
            
            ' 跳过空单元格
            If Not IsEmpty(tempArray(i, j)) And IsNumeric(tempArray(i, j)) Then
                ' 根据列确定小数位数
                Select Case colIndex
                    Case 7, 8, 12 ' G列(7)、H列(8)、L列(12) 需要三位小数
                        decimalPlaces = 3
                    Case Else ' 其他列(D-F, I-K, M) 需要两位小数
                        decimalPlaces = 2
                End Select
                
                ' 格式化数字（截断而不四舍五入）
                tempArray(i, j) = FormatNumberWithPrecision(CDbl(tempArray(i, j)), decimalPlaces)
            End If
        Next j
    Next i
    
    ' 将处理后的数据一次性写回工作表
    dataRange.Value = tempArray
    
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "格式化完成！共处理了 " & dataRange.Rows.Count & " 行数据。", vbInformation
End Sub

' 辅助函数：格式化数字到指定小数位（截断而不四舍五入）
Function FormatNumberWithPrecision(numberValue As Double, decimalPlaces As Integer) As String
    Dim strValue As String
    Dim decimalPos As Integer
    Dim integerPart As String
    Dim decimalPart As String
    
    ' 将数字转换为字符串
    strValue = CStr(numberValue)
    
    ' 查找小数点位置
    decimalPos = InStr(strValue, ".")
    
    If decimalPos > 0 Then
        ' 分离整数和小数部分
        integerPart = Left(strValue, decimalPos - 1)
        decimalPart = Mid(strValue, decimalPos + 1)
        
        ' 截断小数部分到指定位数
        If Len(decimalPart) > decimalPlaces Then
            decimalPart = Left(decimalPart, decimalPlaces)
        Else
            ' 如果小数位数不足，补零
            decimalPart = decimalPart & String(decimalPlaces - Len(decimalPart), "0")
        End If
        
        ' 重新组合
        FormatNumberWithPrecision = integerPart & "." & decimalPart
    Else
        ' 没有小数部分，添加小数点和零
        FormatNumberWithPrecision = strValue & "." & String(decimalPlaces, "0")
    End If
End Function

'' 可以绑定到快捷键或按钮的简化版本
'Sub QuickFormatSelection()
'    ' 确保选择的是行
'    If Selection.Columns.Count > 1 Then
'        MsgBox "请选择整行或若干行！", vbExclamation
'        Exit Sub
'    End If
'
'    ' 调用主格式化函数
'    FormatChemicalComposition
'End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub