基于VisualBasic适用于Excel的自动在不同楼层前插入空行程序

适用背景

        疫情期间社区团购收集信息后导入Excel，为让配送更加清晰明了需要在不同楼层间插入空行用于区分。

程序功能

        本程序有以下功能

        1. 通过房号（第1列）数据获取楼层数据（第10列）

        2. 判断是否为同一层，如不是，在前插入空行

        3. 删除楼层数据（第10列）

        4. 当购买份数数据（第2列）大于1时填充灰色

        5. 为购买份数数据（第2列）添加单位

注意事项

        1. 由于国区Excel默认采用GBK编码，故本程序也采用GBK编码

        2. 使用本程序前请务必查看注释，盲目运行有丢失数据风险

        3. 使用本程序前自行备份原始文件，运行后不可使用撤销功能

使用方式

        打开Excel表格 - 开发工具 - Visual Basic - 项目窗口 - 插入模块 - 粘贴代码

程序代码

Option Explicit
'If you can't see the following comment, Please switch your encoding format to GBK
'Do NOT click SAVE button WHEN you don't switch
'使用前请先阅读以下注意事项以免造成数据丢失 使用宏前请备份文档 使用后不可撤回
'住户楼层默认生成在第10列 如第10列存在数据请根据注释引导进行修改 共需修改4处
'默认数据来源 第1列为住户房号 第2列为预定份数 如需变更请根据注释引导修改 共需修改2处
'添加默认单位为“份” 如需变更请根据注释引导修改共需修改2处
'选中main()过程后运行
'Copyright by Xiaohaohao

Sub main()
    Call getFloor
    Call insertBlankRow
    Call deleteFloor
    Call fillColor
    Call addUnit
End Sub

Sub getFloor()
    Dim i As Integer
    Dim temp As String
    
    For i = 1 To 400
        Dim C As Integer
        C = Len(Cells(i, 1))    '修改住户房号数据来源 将Cells(i,1)修改为Cells(i,<住户房号数据来源列 使用阿拉伯数字>)
        If C = 3 Then
            Let temp = Left(Cells(i, 1), 1)     '修改住户房号数据来源 将Cells(i,1)修改为Cells(i,<住户房号数据来源列 使用阿拉伯数字>)
            Cells(i, 10) = temp     '修改楼层生成位置 将Cells(i,10)修改为Cell(i,<楼层生成列>)
        ElseIf C = 4 Then
            Let temp = Left(Cells(i, 1), 2)     '修改住户房号数据来源 将Cells(i,1)修改为Cells(i,<住户房号数据来源列 使用阿拉伯数字>)
            Cells(i, 10) = temp     '修改楼层生成位置 将Cells(i,10)修改为Cell(i,<楼层生成列>)
        End If
    Next
End Sub

Sub insertBlankRow()
    Dim i As Integer
    Dim d As Boolean
    For i = 2 To 400
        d = Cells(i - 1, 10).Value = Cells(i, 10).Value
        If d Then
            Debug.Print "Ture" & i
        Else
            Debug.Print "False" & i
            Cells(i, 10).EntireRow.insert , CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 1
        End If
    Next i
End Sub

Sub deleteFloor()
    ActiveSheet.Columns(10).Select      '修改住户房号数据来源 将Cells(i,1)修改为Cells(i,<住户房号数据来源列 使用阿拉伯数字>)
    Selection.ClearContents
End Sub

Sub fillColor()
    Dim d As Boolean
    Dim i As Integer
    
    For i = 1 To 400
        d = Cells(i, 2).Value > 1
        If d Then
            ActiveSheet.Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
             End With
        End If
    Next i
End Sub

Sub addUnit()
    Dim i As Integer
    
    For i = 1 To 400
        If Cells(i, 2).Value = "" Then  '修改填充单位 将Cells(i,2)修改为Cells(i,<份数数据来源列>)
        Else
        Cells(i, 2).Value = Cells(i, 2).Value & "份"    '修改填充单位 将"份"改为"<用户自定义单位>"   将本行2处Cells(i,2)修改为Cells(i,<份数数据来源列>)
        End If
    Next i
End Sub