这小东西,整了我一个半小时, 连单元格的定义都要重新查 不熟的东西就是麻烦
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 NextEnd 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 NextEnd 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 NextEnd 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
End Sub
