Sub CheckTableCells()
Application.DisplayAlerts = False
Dim sht As Worksheet
Dim i, j As Integer
For i = 1 To 284
If (Range("e" & i).Value = "") Then
If (Range("a" & (i + 1)).Value = "") Then
If (Range("b" & (i + 1)).Value <> "") Then
If (Range("c" & (i + 1)).Value = "") Then
Range("e" & i).Value = Range("b" & (i + 1)).Value
Rows(i + 1).Delete
End If
End If
End If
End If
Next
End Sub
Sub CheckTableCells1()
Application.DisplayAlerts = False
Dim sht As Worksheet
Dim i, j As Integer
For i = 1 To 539
If (Range("e" & i).Value = "") Then
If (Range("d" & (i)).Value <> "") Then
Range("e" & i).Value = Range("d" & (i)).Value
Range("d" & i).Value = ""
End If
End If
Next
End Sub
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
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
Sub 删除选中单列包含指定字符的行()
'选中单列整列、单列部分都支持
Dim rng As Range, arr, first_row, last_row, first_col, i, j
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
'要删除的字符串数组，空值为删除空单元格，可使用模式匹配
'arr = Array("*一", "*三", "*五")
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
Sub 删除选中单列包含指定字符的行()
'选中单列整列、单列部分都支持
Dim rng As Range, del_rng As Range, arr, first_row&, last_row&, first_col&, i&, j
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
'要删除的字符串数组，空值为删除空单元格，可使用模式匹配
arr = Array("1")
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: tm = Timer '选中区域开始列号
If rng.Row = 1 Then '选中单列整列
For i = title_row + 1 To last_row
For Each j In arr
'只要有一个符合，就删除
If CStr(Cells(i, first_col).Value) Like j Then
If del_rng Is Nothing Then
Set del_rng = Rows(i)
Else
Set del_rng = Union(del_rng, Rows(i))
End If
End If
Next
Next
ElseIf rng.Row > 1 Then '选中单列部分
For i = first_row To last_row
For Each j In arr
If CStr(Cells(i, first_col).Value) Like j Then
If del_rng Is Nothing Then
Set del_rng = Rows(i)
Else
Set del_rng = Union(del_rng, Rows(i))
End If
End If
Next
Next
End If
If Not del_rng Is Nothing Then del_rng.Delete
Debug.Print "删除完成用时：" & Format(Timer - tm, "0.00") '耗时
End Sub
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
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
