如何快速在一个比较大的表格里挑选符合要求的行和列组成一个新的表格

limi926

我是搞工程造价的，每个月都遇到头痛的问题。
我的问题是，在一个大的表格里，删选出符合要求的行和列。
具体问题和要求在我传的附件里，请大神们帮助。 城市花园一期2标段-总台账.rar (16.66 KB, 下载次数: 30)

2013-4-22 20:48 上传

点击文件名下载附件
原表和结果

limi926

这是一个共性的问题，希望有快速有效的解决办法

zjl123

我的办法是用筛选的方法，然后复制，不需要公式，筛选的时候把0和空白不打钩，然后筛选出来就是你想要的，07版本以上的都要台用这个方式筛选

uljghl

办到这样需要三个步骤：1、隐藏你不需要的列，只留下A、B、C、E、L、W列；
                      2、在W列筛选—自定义—大于0，这下就能看见你需要的表格了；
                      3、这次选中你需要的表格，然后：定位—“可见单元格”，复制+粘贴到另一个表；
                      4、注意：其中有合并单元格不能复制，也就是你的表头，你只能从第二行开始复制，表头另外做。

一指禅62

附件           

一指禅62

1. 
   
2. 这是一个 VBA 的，不知道是不是楼主想要的。
   
3. 
   
4. Sub saixuan()
   
5.     Dim Sh As Worksheet, arr(), i As Long, n As Integer, c As Integer
   
6.     Set Sh = Sheets("1#-土建")
   
7.     With Range("A4:Z65536")
   
8.         .ClearContents
   
9.         .Borders.LineStyle = xlNone
   
10.     End With
    
11.     If Not IsDate(Range("C1")) Then
    
12.         Range("C1:D1").Interior.ColorIndex = 3
    
13.         MsgBox "请在红色区域输入日期！"
    
14.         Exit Sub
    
15.     End If
    
16.     Range("C1:D1").Interior.ColorIndex = xlNone
    
17.     For c = 13 To 256
    
18.         If Format(Sh.Cells(1, c), "yyyymm") = Format(Range("C1"), "yyyymm") Then
    
19.             Exit For
    
20.         End If
    
21.     Next
    
22.     If c > 256 Then MsgBox "没有找到 " & Format(Range("C1"), "yyyymm") & " 的记录！": Exit Sub
    
23.     For i = 4 To Sh.Range("A65536").End(3).Row
    
24.         If Sh.Cells(i, c + 1) > 0 Then
    
25.             n = n + 1
    
26.             ReDim Preserve arr(1 To 7, 1 To n)
    
27.             arr(1, n) = Sh.Range("A" & i) '序号
    
28.             arr(2, n) = Sh.Range("B" & i) '项目编码
    
29.             arr(3, n) = Sh.Range("C" & i) '项目名称
    
30.             arr(4, n) = Sh.Range("E" & i) '单位
    
31.             arr(5, n) = Sh.Cells(i, c + 1) '清单量
    
32.             arr(6, n) = Sh.Range("L" & i) '综合单价
    
33.             arr(7, n) = arr(5, n) * arr(6, n) '合价
    
34.         End If
    
35.     Next
    
36.     With Range("A4").Resize(UBound(arr, 2), 7)
    
37.         .Value = WorksheetFunction.Transpose(arr)
    
38.         .Borders.LineStyle = xlContinuous
    
39.     End With
    
40.     Set Sh = Nothing
    
41. End Sub
    

复制代码