[excel ] 数值型格减小十倍的vba

最新推荐文章于 2023-04-03 15:32:03 发布

leniz

最新推荐文章于 2023-04-03 15:32:03 发布

阅读量2.2k

点赞数

文章标签： vba excel integer float

本文链接：https://blog.csdn.net/leniz/article/details/1503934

版权

这小东西,整了我一个半小时, 连单元格的定义都要重新查不熟的东西就是麻烦

Sub Macro1()
'
' Macro1 Macro
' leniz 录制，时间: 2007-2-7
' 这个宏是见数字就缩小 , 初始模型

    Dim row As Integer
    Dim col As Integer
    Dim totalrow As Integer
    Dim totalcol As Integer
    Dim sheetindex As Integer
    Dim currsheet As Worksheet
    Dim totalsheet As Integer
    totalsheet = Worksheets.Count '总行数
    For i = 1 To totalsheet
        totalrow = Sheets(i).UsedRange.Rows.Count
        totalcol = Sheets(i).UsedRange.Columns.Count
        For x = 1 To totalrow              ' 所有行
            For y = 1 To totalcol                    ' 所有列
               If TypeName(Sheets(i).Cells(x, y).Value) = "Double" Then
                Sheets(i).Cells(x, y).Value = Sheets(i).Cells(x, y).Value / 10
               ElseIf TypeName(Sheets(i).Cells(x, y).Value) = "Float" Then
                Sheets(i).Cells(x, y).Value = Sheets(i).Cells(x, y).Value / 10
               ElseIf TypeName(Sheets(i).Cells(x, y).Value) = "Integer" Then
                Sheets(i).Cells(x, y).Value = Sheets(i).Cells(x, y).Value / 10
               End If
            Next y

        Next x
    Next
End Sub

Sub MakeSmallByTen()
'
' Macro1 Macro
' Cmaker:雷国海，时间: 2007-2-7
'
'单元格缩小十倍
'1.数值型
'2.不带公式
'3.不为空
'4.显示为整数( a 实际为整数, b 字面显示为整数)
'
    Dim a As Double
    Dim b As Double
    Dim row As Integer
    Dim col As Integer
    Dim totalrow As Integer
    Dim totalcol As Integer
    Dim sheetindex As Integer
    Dim currsheet As Worksheet
    Dim totalsheet As Integer
    totalsheet = Worksheets.Count '总行数
    For i = 1 To totalsheet
        totalrow = Sheets(i).UsedRange.Rows.Count
        totalcol = Sheets(i).UsedRange.Columns.Count
        For X = 1 To totalrow                        '所有行
            For Y = 1 To totalcol                    '所有列
               If Sheets(i).Cells(X, Y).HasFormula = False And Len(Sheets(i).Cells(X, Y).Text) > 0 Then
                  If TypeName(Sheets(i).Cells(X, Y).Value) = "Double" Then
                      a = CStr(Sheets(i).Cells(X, Y).Text)    '字面值
                      b = Round(Sheets(i).Cells(X, Y).Value) '实际值
                    If a = b Then
                       Sheets(i).Cells(X, Y).Value = Sheets(i).Cells(X, Y).Value / 10
                       Sheets(i).Cells(X, Y).NumberFormatLocal = "0.0_ "
                    End If

                  End If

                End If
            Next Y

        Next X
    Next
End Sub

Sub MakeSmallByTenAll()
'
' Macro1 Macro
' Cmaker:雷国海，时间: 2007-2-7
'
'单元格缩小十倍
'1.数值型
'2.不带公式
'3.不为空
'4.所有数值
'
    Dim a As Double
    Dim b As Double
    Dim row As Integer
    Dim col As Integer
    Dim totalrow As Integer
    Dim totalcol As Integer
    Dim sheetindex As Integer
    Dim currsheet As Worksheet
    Dim totalsheet As Integer
    totalsheet = Worksheets.Count '总行数
    For i = 1 To totalsheet
        totalrow = Sheets(i).UsedRange.Rows.Count
        totalcol = Sheets(i).UsedRange.Columns.Count
        For X = 1 To totalrow                        '所有行
            For Y = 1 To totalcol                    '所有列
               If Sheets(i).Cells(X, Y).HasFormula = False And Len(Sheets(i).Cells(X, Y).Text) > 0 Then
                  If TypeName(Sheets(i).Cells(X, Y).Value) = "Double" Then
                       Sheets(i).Cells(X, Y).Value = Sheets(i).Cells(X, Y).Value / 10
                       'Sheets(i).Cells(X, Y).NumberFormatLocal = "0.0_ "
         If Sheets(i).Cells(X, Y).NumberFormatLocal = "0_" Then
    Sheets(i).Cells(X, Y).NumberFormatLocal = "0.0_"
                       End if
                  End If
                End If
            Next Y
        Next X
    Next
End Sub

Sub MakeSmallByTenAllForActiveSheet()
'
' Macro1 Macro
' Cmaker:雷国海，时间: 2007-2-7
'
'单元格缩小十倍
'1.数值型
'2.不带公式
'3.不为空
'4.所有数值
'5.just for active sheet
    Dim a As Double
    Dim b As Double
    Dim row As Integer
    Dim col As Integer
    Dim totalrow As Integer
    Dim totalcol As Integer
    Dim sheetindex As Integer
    Dim currsheet As Worksheet
    Dim totalsheet As Integer
    totalsheet = Worksheets.Count '总行数

        totalrow = ActiveSheet.UsedRange.Rows.Count
        totalcol = ActiveSheet.UsedRange.Columns.Count
        For X = 1 To totalrow                        '所有行
            For Y = 1 To totalcol                    '所有列
               If ActiveSheet.Cells(X, Y).HasFormula = False And Len(ActiveSheet.Cells(X, Y).Text) > 0 Then
                  If TypeName(ActiveSheet.Cells(X, Y).Value) = "Double" Then
                       ActiveSheet.Cells(X, Y).Value = ActiveSheet.Cells(X, Y).Value / 10
                       'ActiveSheet.Cells(X, Y).NumberFormatLocal = "0.0_ "
         If ActiveSheet.Cells(X, Y).NumberFormatLocal = "0_" Then
    ActiveSheet.Cells(X, Y).NumberFormatLocal = "0.0_"
                       End if
                  End If
                End If
            Next Y
        Next X