道路养护信息统计中可用的一些代码

最新推荐文章于 2021-09-17 10:54:48 发布

dnxk

最新推荐文章于 2021-09-17 10:54:48 发布

阅读量826

点赞数

分类专栏： VBA Excel

本文链接：https://blog.csdn.net/dongdarencai/article/details/8934282

版权

VBA 同时被 2 个专栏收录

6 篇文章 0 订阅

订阅专栏

Excel

6 篇文章 0 订阅

订阅专栏

1、清除数字格式

Sub ClearNumFormat()
    Dim i As Integer
    For i = 1 To Sheets.Count
        Sheets(i).Activate
        Range("E2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormatLocal = "G/通用格式"
        Range("A1").Select
    Next i
End Sub

2、统计有效行

Sub RowsCount()
    Dim i, rwcnt As Integer
    rwcnt = 0
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If Len(Cells(i, "C")) <> 0 Then
            rwcnt = rwcnt + 1
        End If
    Next i
    MsgBox rwcnt
End Sub

3、粘贴为纯文本

Sub PasteAsRawTxt()
    Dim i As Integer
    For i = 1 To Sheets.Count
        Sheets(i).Activate
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select    
    Next i
End Sub

4、数字桩号转为文本桩号

Sub ZhuangHaoTXT()
    Dim i, j, rwcnt As Integer
    For i = 1 To Sheets.Count
        Sheets(i).Activate
        '统计有效行数
        rwcnt = 0
        For j = 1 To ActiveSheet.UsedRange.Rows.Count
            If Len(Cells(j, "C")) <> 0 Then
                rwcnt = rwcnt + 1
            End If
        Next j
    
        '格式化
        If rwcnt > 1 Then
            For j = 2 To rwcnt
                Cells(j, "B") = Format(Cells(j, "C").Value * 1000, "K&&&+&&&")
                Cells(j, "D") = Format(Cells(j, "E").Value * 1000, "K&&&+&&&")
            Next j
        End If
        Cells(1, 1).Select
    Next i
End Sub

5、其它

Sub DivideBy1000()
    Dim i, j, rwcnt As Integer
    For i = 1 To Sheets.Count
        Sheets(i).Activate
        '统计有效行数
        rwcnt = 0
        For j = 1 To ActiveSheet.UsedRange.Rows.Count
            If Len(Cells(j, "C")) <> 0 Then
                rwcnt = rwcnt + 1
            End If
        Next j
    
        '清除有效行以外的所有内容
        Rows(rwcnt + 1).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Clear
        
        'C列每个单元格数值除以1000
        If rwcnt > 1 Then
            For j = 2 To rwcnt
                Cells(j, "E").Value = Cells(j, "E").Value / 1000
            Next j
        End If
        Cells(1, 1).Select
    Next i
End Sub