要点：
双循环遍历所有表表头
InStr函数匹配具体内容（word表格多半有特殊字符，相等匹配较难保证）
在内循环结束后进行删除，否则将出错

用法：
1、定义条件，如 InStr(value1, “学号”)，多条件拼接(如 InStr(value1, “学号”)>0 or InStr(value1, “姓名”) >0)
2、新建宏名range，粘贴内容到vba编辑器
3、执行

效果：

代码：

'ver 2.0

Sub range()
'遍历文档所有表格，删除表头第一行含有特定字符串的列
Dim value1 As String
Dim target() As Integer
For i = 1 To ActiveDocument.Tables.Count
  Dim targetLen As Integer
  targetLen = 0
  For j = 1 To ActiveDocument.Tables(i).Columns.Count
     value1 = ActiveDocument.Tables(i).Columns(j).Cells(1).range.Text
     '这里定义条件，可以定义多个条件
     If InStr(value1, "测试") > 0 or InStr(value1, "学号") > 0 Then
     targetLen = targetLen + 1
     ReDim Preserve target(targetLen)
     target(targetLen - 1) = j
     Else
     End If
  Next j
  If targetLen <> 0 Then
  ' MsgBox targetLen
    ' 修正删除操作带来的列号偏移
   Dim shift As Integer
   shift = 0
   For k = 0 To (targetLen - 1)
     ' MsgBox target(k)
       ActiveDocument.Tables(i).Columns(target(k) - shift).Delete
       shift = shift + 1
    Next k
  End If
Next i
    MsgBox ("执行完毕。")
End Sub

使用过程中遇到复合表格遍历报错问题，修改加入错误处理跳过
（注意，因需求变动这里已经改成了匹配第一列，如仍需匹配第一行，请按上一段代码循环条件设置）

'ver 3.0
Dim value1 As String
Dim target() As Integer
For i = 1 To ActiveDocument.Tables.Count
  'MsgBox ("遍历表 " & i & "。")
  Dim targetLen As Integer
  targetLen = 0
  For j = 1 To ActiveDocument.Tables(i).Rows.Count
     On Error GoTo flag
     value1 = ActiveDocument.Tables(i).Rows(j).Cells(1).range.Text
     '这里定义条件
     If InStr(value1, "test1") > 0 Or InStr(value1, "test2") > 0  Then
     targetLen = targetLen + 1
     ReDim Preserve target(targetLen)
     target(targetLen - 1) = j
     Else
     End If
  Next j
  If targetLen <> 0 Then
  ' MsgBox targetLen
    ' 修正删除操作带来的列号偏移
   Dim shift As Integer
   shift = 0
   For k = 0 To (targetLen - 1)
     ' MsgBox target(k)
       ActiveDocument.Tables(i).Rows(target(k) - shift).Delete
       shift = shift + 1
    Next k
  End If
flag:
    Resume continue
continue:
Next i
    MsgBox ("执行完毕。")
End Sub

如需删除而非跳过复合行，则删除代码需换成下列实现形式

 With ActiveDocument
        .Tables(1).Cell(2, 2).Delete ShiftCells:=wdDeleteCellsEntireRow
    End With

1 要解决的问题：删除某列中的空单元格/空行

暂时只实现了删除一列中的空行，并没有实现多行的判断空行和删除方法。----之后再做更复杂的

1.1 需求分析

用VBA删除如下内容，解决思路都不同

1. 删除1列的空行（本文要做的）
2. 删除整个区域内的空行
3. 删除整个区域内的空格（这个一般很少有这种需求，用处不大----可用currentregion .specialcells()解决）
4. 下面是原始数据，下面看看如何处理

2 如果是删除全表/某区域的空单元格, 直接在当前列删除

简洁代码：删除区域内所有空单元格 cells ---实际需要少，so用处不大

使用 sheet.usedrange / region.currentregion .specialcells()

• 删除，表格页面内使用区域的空格所在的行
• 局限性就是表格的上方，左边还会存在一些空行空列，不过这个手动删下就可以了
• 这个只是删除了空的cells 并不是删除了空行

Sub 删空单元格()

 ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Delete
 
End Sub

3 如果是删一列的空行

3.1 代码1：基础代码，假设确认知道这列的长度，关键是倒着删

• 熟悉 isempty() 或者用 if   xxxx=""
• 删除单元格后，要设置属性 shift:=xlup等
• 需要倒着删除，否则会因为一边删除行，一遍重新排列有问题

Sub 删一列的空行()

   For i = 20 To 1 Step -1    '需要倒着删除
      If IsEmpty(Cells(i, 1)) Then
         Cells(i, 1).Delete shift:=xlUp
      End If
   Next i
   
End Sub

3.2 改进版: 先查这一列的非空最大行数

Sub jackma_delete_row()


For i = Range("c65536").End(xlUp).Rows To 1 Step -1

   If IsEmpty(Cells(i, 3)) Then
      rows(i).Delete shift:=xlUp
   End If

Next i

End Sub

3.3 也可以不用 isempty()  函数，直接判断  if cells()=""

• 直接判断 if cells(i,j) =""
• 这种删除整行不合适  rows(i) .delete，会影响其他列的元素

Sub ponyma_del_row1()

For i = Range("c65536").End(xlUp).Row To 1 Step -1
   If Cells(i, 3) = "" Then
      Cells(i, 3).Delete
'      Rows(i).Delete
   End If

Next i

End Sub

3.3 如果是要先删除前面的 重复行，可以正着查询。

'这次收到的需求是，要删掉相同的行里，前面的行
Sub del_test2()


Dim ws1 As Object
Dim ws2 As Object
Dim ws3 As Object

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Set ws3 = Worksheets("sheet3")


'maxr1 = ws1.Range("a1").End(xlDown).Row

'删行后会导致行数变少
'End(xlDown) 最大的问题还是可能一列中间有空的，断了，查找不准
'反过来查比较准, range("a9999").end(xlup).row
                                           
                                           
maxr1 = 999       '其实经验发现，把这些配置值放表里出错可能性大，要么弄个控件，要么干脆放代码里

For i = 1 To maxr1

  If WorksheetFunction.CountIf(ws1.Columns(1), ws1.Cells(i, 1)) > 1 Then
     ws1.Rows(i).Delete
  End If


Next



Debug.Print "done"

End Sub

4 不动原数据，将非空数据放到另外一列

4.1 错误版：

• 要明白“写入列”的循环数，明显和“输出列”的循环数 应该不同！
• 这么写相当于 输出列 那行为空的时候，只是不往 写入列写，所以没覆盖，也是空的

Sub jackma_delete_row2()

For i = 1 To Range("c65536").End(xlUp).Rows

   If Not IsEmpty(Cells(i, 3)) Then
      Cells(i, 9) = Cells(i, 3)
   End If

Next i

End Sub

4.2 正确版： 写入列/输出列，应该是单独的循环变量！

Sub jackma_delete_row2()
k = 1

For i = 1 To Range("c65536").End(xlUp).Rows

   If Not IsEmpty(Cells(i, 3)) Then
      Cells(k, 9) = Cells(i, 3)
      k = k + 1
   End If

Next i

End Sub

5 先写入数组array中，再写到其他地方，据说这样能大幅提高速度！

把需要的筛选的数据，存在数据，然后从数组写到需要的地方，这是个好习惯

第1版：局限性很大，没有自动查这列的 元素个数，以及 最大非空行是多少

Sub 删除空格4()
Dim arr1()                          '定义了一个数组，并且是动态数组，因为没指定大小
 
 
ReDim arr1(11)                      '动态数组，使用前必须重新redim，数组大小
j = 0                              'j=1开始，不会越界，但arr1(0)为空，因为赋值跳过了它
For i = 1 To 11 Step 1
   If Not IsEmpty(Cells(i, 1)) Then
      arr1(j) = Cells(i, 1)
      j = j + 1
   End If
Next i
 
 
For j = 0 To UBound(arr1())
    Cells(j + 1, 9) = arr1(j)      '单元格得从1开始，arr()，默认得从0开始，但可以改
Next j
 
 
End Sub

第2版重写

• 注意debug.print用来监测的时候，需要注意，放在循环的位置，尤其是在k=K+1这种变化时，和放在哪个for循环之内外！

Sub ponyma_array22()
Dim arr1()  '当数组定义，且默认开始的index为0！ preserve时需要有0的index
'dim arr1 当变量定义


k = 1
m = 1


ReDim arr1(0 To Application.WorksheetFunction.CountA(Range("c:c")))

   For i = 1 To Range("c65536").End(xlUp).Row Step 1
       If Cells(i, 3) <> "" Then
     
          Debug.Print Cells(i, 3)
          arr1(k) = Cells(i, 3)
          Debug.Print arr1(k)
          k = k + 1
'          Debug.Print arr1(k),写在这里问题1：k已经变了，下一个k还没赋值为空，2最后的k越界
'          循环是很精巧的，放的地方很讲究，放得不对，就错误百出
'           Debug.Print arr1(k) 如果放在k=K+1 后，就看起来没打印出东西，因为都打印的arr1的空元素
         
       End If
   Next i
   
   For j = 1 To UBound(arr1(), 1)
       Cells(m, 10) = arr1(j)
       m = m + 1
   Next j

End Sub

第3版

Option Explicit

Sub ponyma1()


Dim arr1()
Dim k1, k2, k
Dim i, j
k1 = WorksheetFunction.CountA(Range("a:a"))
k2 = Range("a65536").End(xlUp).Row
Debug.Print "这列非空数据个数k1=" & k1
Debug.Print "这列最后1个有数据的行数k2=" & k2


'arr1(0) = 1
'ReDim Preserve arr1(1, k)
'这样会越界，因为你需要preserve数据。但是index系不符合
'但是，如果不preserve 就无所谓
'或者虽然 dim arr1() 是动态数据从index0开始，但是arr1()一直为空,preserve也不会出现index越界问题

ReDim Preserve arr1(1 To k1)
'ReDim Preserve arr1(1, k1) 这样就会越界。。。因为语法是2维数组了！
'ReDim Preserve arr1(1 to k1) 这样就对的

k = 1
For i = 1 To k2
   If Cells(i, 1) <> "" Then
      arr1(k) = Cells(i, 1)
      Debug.Print arr1(k)
      k = k + 1
   End If
Next i

sub1.删除工作表所有空行

Sub 删除工作表所有空行()
    Dim first_row, last_row, i
    first_row = ActiveSheet.UsedRange.Row
    last_row = first_row + ActiveSheet.UsedRange.Rows.count - 1
    For i = last_row To first_row Step -1   '倒序循环
        If WorksheetFunction.CountA(Rows(i)) = 0 Then
            Rows(i).Delete  '删除行
        End If
    Next
End Sub

sub2.删除工作表所有空列

Sub 删除工作表所有空列()
    Dim first_col, last_col, i
    first_col = ActiveSheet.UsedRange.Column
    last_col = first_col + ActiveSheet.UsedRange.Columns.count - 1
    For i = last_col To first_col Step -1   '倒序循环
        If WorksheetFunction.CountA(Columns(i)) = 0 Then
            Columns(i).Delete  '删除列
        End If
    Next
End Sub

sub3.删除选中单列包含指定字符的行

Sub 删除选中单列包含指定字符的行()
    '选中单列整列、单列部分都支持
    Dim rng As Range, arr, first_row, last_row, first_col, i, j
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
    '要删除的字符串数组，空值为删除空单元格，可使用模式匹配
    arr = Array("*一", "*三", "*五")
    title_row = 1        '表头行数，不执行删除
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub  '仅支持单列，多列则退出
    first_row = WorksheetFunction.Max(title_row, rng.Row)  '表头行与选中区域开始行号的大值
    last_row = rng.Row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    
    If rng.Row = 1 Then  '选中单列整列
        For i = last_row To title_row + 1 Step -1  '倒序循环
            For Each j In arr
                '只要有一个符合，就删除
                If Cells(i, first_col) Like j Then Rows(i).Delete
            Next
        Next
    ElseIf rng.Row > 1 Then  '选中单列部分
        For i = last_row To first_row Step -1  '倒序循环
            For Each j In arr
                If Cells(i, first_col) Like j Then Rows(i).Delete
            Next
        Next
    End If
End Sub

举例

A列选中运行sub3后得到C列效果

sub4.删除选中单列不含指定字符的行

Sub 删除选中单列不含指定字符的行()
    '选中单列整列、单列部分都支持
    Dim rng As Range, arr, first_row, last_row, first_col, i, j, del_if As Boolean
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
    '要保留的字符串数组，空值为保留空单元格，可使用模式匹配
    arr = Array("*一", "*三", "*五")
    title_row = 1        '表头行数，不执行删除
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub  '仅支持单列，多列则退出
    first_row = WorksheetFunction.Max(title_row, rng.Row)  '表头行与选中区域开始行号的大值
    last_row = rng.Row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    
    If rng.Row = 1 Then   '选中单列整列
        For i = last_row To title_row + 1 Step -1  '倒序循环
            del_if = True   '初始为删除
            For Each j In arr
                '只要有一个符合，就不删除
                If Cells(i, first_col) Like j Then del_if = False: Exit For
            Next
            '都不符合，删除
            If del_if Then Rows(i).Delete
        Next
    ElseIf rng.Row > 1 Then  '选中单列部分
        For i = last_row To first_row Step -1  '倒序循环
            del_if = True    '初始为删除
            For Each j In arr
                If Cells(i, first_col) Like j Then del_if = False: Exit For
            Next
            If del_if Then Rows(i).Delete
        Next
    End If
End Sub

举例

A列选中运行sub4后得到C列效果

sub5.删除选中列重复的整行

对于选中多行多列区域，在一行中所有列的内容都重复，则删除该行，仅保留唯一一行，注意区分字母大小写

Sub 选中列去重()
    '适用单/多列选中、单/多列部分选中，去重删除整行
    Dim rng As Range, dict As Object, first_row, last_row, first_col, last_col, i, j, res
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    first_row = rng.Row     '选中区域开始行号
    last_row = first_row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    last_col = first_col + rng.Columns.count - 1  '选中区域结束列号
    Set dict = CreateObject("scripting.dictionary")
    
    For i = last_row To first_row Step -1   '倒序循环，避免遗漏
        res = ""
        For j = first_col To last_col
            res = res & CStr(Cells(i, j).Value)
        Next
        If Not dict.Exists(res) Then  '字典键不存在，新增
            dict(res) = ""
        Else
            Rows(i).Delete  '删除行
        End If
    Next
    
End Sub

举例

《excel吧提问-多行多列重复数据筛选》

多列去重前

选中A-D列，运行sub5，获得结果