【WPS+VBA】表格中重复表头与页码的批量删除

发布于:2025-02-23 ⋅ 阅读:(21) ⋅ 点赞:(0)

向豆包对话可以死磕的,以前问问题我只是根据第一条给出的答案使用。AI还有个优点,不会烦你,只要有问题就接着问,一直问到解决好问题。小编对豆包的连环提问,最终解决了批量删表头页面的问题。

1、豆包对话过程

开始问题1:

excel表格中隔几行就会出相同(有多行)的表头,如何只保留一个表头,中间的表头都去掉,在wps里怎么快速实现,用VBA实现。

出现错误接着问2:

If ws.Range(ws.Cells(i, 1), ws.Cells(i + headerRow - 1, ws.Cells(1, ws.Columns.Count).End(xlToRight).Column)).Value = headerRange.Value Then这行代码显示有错误,表头有5行

还是不行接问3:

设置表头区域的代码是否要根据表的情况进行修改

问4:

表头如果有些单元格是合并的,有没有影响,是否要改代码

问5:

执行完还是没有删除表头,代码中设置表头区域注释下的代码是否要修改

问6:

表头是从一行一列开始的,表头范围是1-5行,A-L列,表头中第四行与第五行中有些单元格是合并的

问7:

还是不行,宏运行没有报错,运行的过程跟结果在哪里看

问8:

不知道你理解完整我的需求不,目前第一个表头范围(A1,L5),第二个表头(A28,L32)...,我需要的就是只保留第一个表头,能确定表头范围内的内容一致,表头范围内有合并单元格,现在需要完整的可执行的VBA代码

问9:

只删除了一个,我需要删除与表头一样的,且我不需要找规律,适应第二个表头不是A28:L32范围的

。。。

问100:

当前 i 的值: 1 headerRowCount 的值: 0 i + headerRowCount - 1 的值: 0

通过一些列的问题,最终获得一段满意的vba代码:

Sub RemoveDuplicateHeadersAndPageNumbers()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim headerRowCount As Long
    Dim headerRange As Range
    Dim checkRange As Range
    Dim i As Long
    Dim isSame As Boolean
    Dim cell As Range
    Dim pageNumberRows As Long
    
    ' 设置要操作的工作表,可根据实际情况修改
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 获取数据区域的最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 表头行数
    headerRowCount = 5
    
    ' 设置第一个表头区域
    Set headerRange = ws.Range("A1:L5")
    
    ' 页码所占行数
    pageNumberRows = 1
    
    ' 先删除重复表头
    i = headerRowCount + 1
    Do While i <= lastRow - headerRowCount + 1
        ' 输出调试信息,查看变量值
        Debug.Print "当前 i 的值: " & i
        Debug.Print "headerRowCount 的值: " & headerRowCount
        Debug.Print "i + headerRowCount - 1 的值: " & (i + headerRowCount - 1)
        
        Set checkRange = ws.Range(ws.Cells(i, 1), ws.Cells(i + headerRowCount - 1, 12)) ' 12 代表 L 列
        isSame = True
        
        ' 逐单元格比较
        For Each cell In headerRange
            Dim correspondingCell As Range
            Set correspondingCell = checkRange.Cells(cell.Row - headerRange.Row + 1, cell.Column)
            
            ' 处理合并单元格
            Dim mergedValue1 As Variant
            Dim mergedValue2 As Variant
            If cell.MergeCells Then
                mergedValue1 = Trim(cell.MergeArea.Cells(1, 1).Value)
            Else
                mergedValue1 = Trim(cell.Value)
            End If
            If correspondingCell.MergeCells Then
                mergedValue2 = Trim(correspondingCell.MergeArea.Cells(1, 1).Value)
            Else
                mergedValue2 = Trim(correspondingCell.Value)
            End If
            
            ' 将值转换为文本格式进行比较
            If CStr(mergedValue1) <> CStr(mergedValue2) Then
                isSame = False
                Exit For
            End If
        Next cell
        
        ' 如果相同则删除对应的行
        If isSame Then
            ws.Rows(i & ":" & (i + headerRowCount - 1)).Delete
            ' 因为删除了行,所以更新最后一行
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        Else
            ' 如果不相同,移动到下一行
            i = i + 1
        End If
    Loop
    
    ' 重新获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 再删除页码行和空白行
    i = lastRow
    Do While i > headerRowCount
        ' 检查是否为页码行
        Dim isPageNumber As Boolean
        isPageNumber = True
        For j = 0 To pageNumberRows - 1
            Dim currentCell As Range
            Set currentCell = ws.Cells(i - j, 1)
            Dim rowValue As String
            rowValue = Trim(currentCell.MergeArea.Cells(1, 1).Text)
            ' 检查是否为合并单元格
            If Not currentCell.MergeCells Then
                isPageNumber = False
                Debug.Print "第 " & (i - j) & " 行:不是合并单元格"
                Exit For
            End If
            ' 检查内容是否为纯数字文本
            If Not IsNumeric(rowValue) Or Not IsAllDigits(rowValue) Then
                isPageNumber = False
                Debug.Print "第 " & (i - j) & " 行:内容不是纯数字文本,内容为 " & rowValue
                Exit For
            End If
            ' 检查内容是否居中
            If currentCell.HorizontalAlignment <> xlCenter Then
                isPageNumber = False
                Debug.Print "第 " & (i - j) & " 行:内容未居中,对齐方式为 " & currentCell.HorizontalAlignment
                Exit For
            End If
        Next j
        
        If isPageNumber Then
            ' 删除页码行
            ws.Rows(i - pageNumberRows + 1 & ":" & i).Delete
            ' 因为删除了行,所以更新最后一行
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            i = i - pageNumberRows
            Debug.Print "已删除第 " & (i - pageNumberRows + 1) & " 行到第 " & i & " 行的页码行"
        Else
            i = i - 1
        End If
    Loop
End Sub
Function IsAllDigits(str As String) As Boolean
    Dim i As Long
    For i = 1 To Len(str)
        If Not Mid(str, i, 1) Like "[0-9]" Then
            IsAllDigits = False
            Exit Function
        End If
    Next i
    IsAllDigits = True
End Function

2、wps测试

2.1 首先得安装wps宏,wps.vba.exe,文末分享:

2.2 打开我们预算文件表格,那种直接可以打印的预算excel。找到开发工具——点击录制宏——停止——点击vb宏。

2.3 点击宏编辑进入vba编辑

2.4 复制豆包生成的代码,修改对应表格名称,根据表头的情况对代码进行修改(有注释,代码好理解)。

3、视频教程与资料分享

3.1 视频操作流程:

WPS+VBA删除表格中多余的表头、页码、空白页

3.2 素材下载(含wps.vba.exe),公号回复:vba删表头。