|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
请参考
- Sub cx()
- Application.ScreenUpdating = False
- Dim endrow As Long
- Dim i As Long, j As Long
- Dim r As Long
- Dim flag As Boolean
- ActiveSheet.Unprotect
- Range("A7:O" & Rows.Count).ClearContents
- Range("A7:O" & Rows.Count).Borders.LineStyle = xlNone
- r = 6
- With Sheet4
- endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
- For i = 3 To endrow
- flag = True
- If Range("A3") <> "" And Range("A3") <> .Cells(i, "A") Then
- flag = False
- End If
- If Range("B3") <> "" And Range("B3") <> .Cells(i, "B") Then
- flag = False
- End If
- If Range("C3") <> "" And Not .Cells(i, "E") Like "*" & Range("C3") & "*" Then
- flag = False
- End If
- If Range("D3") <> "" And Not .Cells(i, "N") Like "*" & Range("D3") & "*" Then
- flag = False
- End If
- If flag = True Then
- r = r + 1
- For j = 1 To 15
- Cells(r, j) = .Cells(i, j)
- Next
- End If
- Next
- End With
- ActiveSheet.Protect
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|