[已解决]求助如何快速清空黄色区域的数据（有规律）

qinhuan66

求助如何快速清空黄色区域的数据（有规律），没有色的也一样（类似红框内的所有都要清空）。谢谢
求助.rar (38.28 KB, 下载次数: 8)

2013-6-17 10:47 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-17 11:26

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     arr = ActiveSheet.UsedRange.Value
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Application.EnableEvents = False
   
7.     For lrow = LBound(arr) To UBound(arr)
   
8.         If arr(lrow, 1) = "准考证号" Then
   
9.             For j = lrow To lrow + 1
   
10.                 For k = 2 To UBound(arr, 2) Step 6
    
11.                     arr(j, k) = ""
    
12.                 Next
    
13.             Next
    
14.             arrPos = Array(0, 2, 4, 8, 10, 14, 16)
    
15.             For k = LBound(arrPos) + 1 To UBound(arrPos)
    
16.                 arr(j, arrPos(k)) = ""
    
17.             Next
    
18.             lrow = j
    
19.         End If
    
20.     Next
    
21.     ActiveSheet.UsedRange.Value = arr
    
22.     Application.ScreenUpdating = True
    
23.     Application.DisplayAlerts = True
    
24.     Application.EnableEvents = True
    
25.     MsgBox "清除完成"
    
26. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     arr = ActiveSheet.UsedRange.Value
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Application.EnableEvents = False
   
7.     For lrow = LBound(arr) To UBound(arr)
   
8.         If arr(lrow, 1) = "准考证号" Then
   
9.             For j = lrow To lrow + 1
   
10.                 For k = 2 To UBound(arr, 2) Step 6
    
11.                     arr(j, k) = ""
    
12.                 Next
    
13.             Next
    
14.             arrPos = Array(0, 2, 4, 8, 10, 14, 16)
    
15.             For k = LBound(arrPos) + 1 To UBound(arrPos)
    
16.                 arr(j, arrPos(k)) = ""
    
17.             Next
    
18.             lrow = j
    
19.         End If
    
20.     Next
    
21.     ActiveSheet.UsedRange.Value = arr
    
22.     Application.ScreenUpdating = True
    
23.     Application.DisplayAlerts = True
    
24.     Application.EnableEvents = True
    
25.     MsgBox "清除完成"
    
26. End Sub

复制代码

suxiong

是否是你想要的？

1. Sub a()
   
2. Dim x, y
   
3. 
   
4. For x = 1 To Range("a6500").End(xlUp).Row
   
5. For y = 1 To 16
   
6. If Cells(x, y).Interior.Color = 65535 Then Cells(x, y).MergeArea.ClearContents
   
7. Next
   
8. Next
   
9. 
   
10. End Sub

复制代码

求助.zip (84.62 KB, 下载次数: 1)

2013-6-17 11:28 上传

点击文件名下载附件

那么的帅

303118-VBA-清空指定区域.rar (34.68 KB, 下载次数: 5)

2013-6-17 11:31 上传

点击文件名下载附件

VICC

请指教

Sub test1()
Dim x As Integer
Dim y As Integer
For x = 1 To Range("a65536").End(xlUp).Row
For y = 1 To 100
If Cells(x, y) = "准考证号" Or Cells(x, y) = "姓名" Then
Cells(x, y).Offset(0, 1).Select
Selection.ClearContents
End If
If Cells(x, y) = "试室" Then
Union(Cells(x, y).Offset(0, 1), Cells(x, y).Offset(0, 3)).Select
Selection.ClearContents
End If
Next
Next
End Sub