把Ｎ个sheet中的Ｃ列等130的记录集中拷贝到统计sheet中

dnl

请教把Ｎ个sheet中的Ｃ列等130的记录集中拷贝到统计sheet中，附件中是3个，实际有可能是Ｎ个。谢谢指导！

笑着...两年过去

1. Sub test()
   
2.     For Each i In Sheets
   
3.         If i.Name <> "统计" Then
   
4.            For j = 1 To i.[a9999].End(3).Row
   
5.                If i.Cells(j, 3) = 130 Then
   
6.                   k = k + 1
   
7.                   i.Rows(j).Copy Sheet4.Cells(k, 1)
   
8.                End If
   
9.            Next
   
10.         End If
    
11.     Next
    
12. End Sub

复制代码

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set ash = ActiveSheet
    ash.UsedRange.ClearContents
    a = 1
    For Each sh In Sheets
        If sh.Name <> ash.Name Then
            Set rn = Nothing
            With sh
                For j = 1 To .Cells(Rows.Count, 3).End(3).Row
                    If .Cells(j, 3) = 130 Then
                        If rn Is Nothing Then
                            Set rn = .Cells(j, 1).EntireRow
                        Else
                            Set rn = Union(rn, .Cells(j, 1).EntireRow)
                        End If
                    End If
                Next j
            End With
            If Not rn Is Nothing Then
                rn.Copy ash.Cells(a, 1)
                a = ash.Cells(Rows.Count, 3).End(3).Offset(1).Row
            End If
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

凌空一羽

Sub 等于130()
Dim sht As Worksheet
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.FullName
For Each sht In Sheets
    If sht.Name <> "统计" Then
        Sql = Sql & " union all  select * from [" & sht.Name & "$] where f3=130"
    End If
Next
Sql = Mid(Sql, 11, 999)
Range("a1").CopyFromRecordset cnn.Execute(Sql)
cnn.Close
Set cnn = Nothing
End Sub

dnl

笑着...两年过去 发表于 2017-2-9 10:54

很喜欢精简的公式。如果想增加"=131"条件的也拷贝过来，怎么改条件？谢谢！

dnl

笑着...两年过去 发表于 2017-2-9 10:54

若加上：

09.　　If i.Cells(j, 3) = 131 Then

10.                  k = k + 1

11.                  i.Rows(j).Copy Sheet4.Cells(k, 1)

12.               End If
也是可以的，但觉得有点啰嗦。

笑着...两年过去

dnl 发表于 2017-2-13 10:36
若加上：

09.　　If i.Cells(j, 3) = 131 Then

1. If i.Cells(j, 3) = 130 or i.Cells(j, 3) = 131 Then

复制代码

dnl

笑着...两年过去 发表于 2017-2-13 11:15

谢谢!我写.or.了。
如果表中的值为130001、130002.……。，怎么取ｌｅｆｔ前3=130?麻烦老师了！

dnl

01.If left(i.Cells(j, 3),3) = 130 or i.Cells(j, 3) = 131 Then  可以了。谢谢指导！