[已解决]自动调整工作表

empty7401

如何将表1自动变成表2（在原表上改）.求代码。表1的大小是固定的，A3、Q3、A104单元格是固定的，其他数据全是变动的，包括部门及费用项目、数据。（即如果有多余的行列全部删除，将总计所在的行列删除，就能达到表2。） 调整工作表.rar (11.23 KB, 下载次数: 20)

2011-7-8 10:34 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

jkczfpb

2011-7-8 11:28

回复 empty7401 的帖子

1. Sub SCDY()
   
2. Dim i As Long, B As Byte
   
3. Sheet1.Copy After:=Sheet1
   
4. B = 103
   
5. For i = 103 To 4 Step -1
   
6. If WorksheetFunction.CountBlank(Range("A" & i & ":P" & i)) = 16 Or Range("A" & i).Value = "总计" Then B = B - 1: Rows(i).Delete
   
7. Next
   
8. For i = 16 To 2 Step -1
   
9. If WorksheetFunction.CountBlank(Range(Cells(4, i), Cells(B, i))) = B - 3 Or Cells(3, i).Value = "总计" Then Columns(i).Delete
   
10. Next
    
11. End Sub

复制代码

如果是删除横竖都没有数据的使用此代码

1. Sub SCDY()
   
2. Dim i As Long, B As Byte
   
3. Sheet1.Copy After:=Sheet1
   
4. B = 103
   
5. For i = 103 To 4 Step -1
   
6. If WorksheetFunction.CountBlank(Range("B" & i & ":P" & i)) = 15 Or Range("A" & i).Value = "总计" Then B = B - 1: Rows(i).Delete
   
7. Next
   
8. For i = 16 To 2 Step -1
   
9. If WorksheetFunction.CountBlank(Range(Cells(4, i), Cells(B, i))) = B - 3 Or Cells(3, i).Value = "总计" Then Columns(i).Delete
   
10. Next
    
11. End Sub

复制代码

如果删除竖没有数据，横没有表头的使用此代码

跳转到最佳答案楼层

罗晓锋

直接删除就可以了

QLZ0602

Sub a()
  For i = Range("a65536").End(xlUp).Row To 1 Step -1
    If Cells(i, Range("iv" & i).End(xlToLeft).Column) = 0 Or Cells(i, 1) = "总计" Then
     Rows(i).Delete
    End If
  Next i
  For i = Range("iv3").End(xlToLeft).Column To 1 Step -1
    If Cells(Range("a65536").End(xlUp).Row, i) = 0 Or Cells(2, i) = "总计" Then
     Columns(i).Delete
    End If
  Next i
End Sub

jkczfpb

回复 empty7401 的帖子

1. Sub SCDY()
   
2. Dim i As Long, B As Byte
   
3. Sheet1.Copy After:=Sheet1
   
4. B = 103
   
5. For i = 103 To 4 Step -1
   
6. If WorksheetFunction.CountBlank(Range("A" & i & ":P" & i)) = 16 Or Range("A" & i).Value = "总计" Then B = B - 1: Rows(i).Delete
   
7. Next
   
8. For i = 16 To 2 Step -1
   
9. If WorksheetFunction.CountBlank(Range(Cells(4, i), Cells(B, i))) = B - 3 Or Cells(3, i).Value = "总计" Then Columns(i).Delete
   
10. Next
    
11. End Sub

复制代码

如果是删除横竖都没有数据的使用此代码

1. Sub SCDY()
   
2. Dim i As Long, B As Byte
   
3. Sheet1.Copy After:=Sheet1
   
4. B = 103
   
5. For i = 103 To 4 Step -1
   
6. If WorksheetFunction.CountBlank(Range("B" & i & ":P" & i)) = 15 Or Range("A" & i).Value = "总计" Then B = B - 1: Rows(i).Delete
   
7. Next
   
8. For i = 16 To 2 Step -1
   
9. If WorksheetFunction.CountBlank(Range(Cells(4, i), Cells(B, i))) = B - 3 Or Cells(3, i).Value = "总计" Then Columns(i).Delete
   
10. Next
    
11. End Sub

复制代码

如果删除竖没有数据，横没有表头的使用此代码

empty7401

非常感谢大家帮忙，多谢多谢！新手上路请多帮忙！！

empty7401

回复 QLZ0602 的帖子

呵呵，你的代码精简而实用！！！一开始是我没有用好。请教一下，如果几个工作表同时运行，应该怎样加入代码？

QLZ0602

回复 empty7401 的帖子

有没有附件?
可不可以再加一个循环

FOR I=1 TO WORKSHEETS.COUNT

NEXT I

colin_duan

学习学习一下。thank you very much!