从若干工作表中提取一个人的数据，并粘贴到一个新表里

吴中泉

希望123456 发表于 2023-5-15 17:45
两个问题，第一，我那个写法是参照了录制宏的代码写的，可是就算按照你说的ROWS("I"),好像也运行不了，第 ...

第一，“可是就算按照你说的ROWS("I"),好像也运行不了” ，我说明的这句I是小写，并且没有双引号，是这样的：rows(i)，确实你这样改了也还是运行不了，因为你要复制到的表“sheet1”不存在。还有其它原因，所以我改成了我以上的代码。
第二、加上这句：exit for 是退出本次循环。就是当一张工资表中找到了这个人的工资条，就不要再继续往下找了。因为一张表中一个人只有一条记录。

希望123456

吴中泉 发表于 2023-5-15 19:25
第一，“可是就算按照你说的ROWS("I"),好像也运行不了” ，我说明的这句I是小写，并且没有双引号，是这样 ...

sheet1我加了，第一个问题我在试试！第二个问题，就算找到了，不需要找，那我让程序继续往下运行，按道理也不会影响结果呀，最多多循环几次

吴中泉

希望123456 发表于 2023-5-15 19:31
sheet1我加了，第一个问题我在试试！第二个问题，就算找到了，不需要找，那我让程序继续往下运行，按道理 ...

第二个问题你理解是对的，至于出现问题，可以看看你那些工资表是否规范一致，另外，for x = 4 to 50 这句写固定死了，可能有的工资表记录超过了50行，超过的部分就查不到。

cyq4896

希望123456 发表于 2023-5-15 18:02
可是我要查找出所有的记录，不是应该把那两个if删除吗？可是删除后，我感觉读取表的名字不对？

查全部只去掉内层if就行了

希望123456

根据各位大佬提供的思路，我修改了一下，请大家批评指正，谢谢！

方法一：Sub 按钮1_Click()                                                                  
Dim s As Worksheet
Dim i As Integer
i = 1
For Each s In Sheets
If s.Name <> "汇总" Then
    For x = 2 To 20
        If s.Cells(x, 1) = Sheets("汇总").[q12] Then
        s.Rows(x).Copy Sheets("汇总").Range("a" & i + 1)
        Sheets("汇总").Cells(i + 1, "s") = s.Name
       i = i + 1
        End If
     Next
End If
Next
End Sub

方法二：

Sub 按钮3_Click()
Dim s As Worksheet
i = 1
For Each s In Worksheets
If s.Name <> "汇总" Then
    For x = 2 To 20
    If s.Cells(x, 1) = Sheets("汇总").[q12] Then
     s.Select
     Rows(x).Select
     Selection.Copy
   
   Sheets("汇总").Select

    Rows(i + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("汇总").Cells(i + 1, "s") = s.Name
    i = i + 1
    End If
Next
End If
Next
End Sub


方法三：

Sub 按钮1_Click()
Dim i%, j%, k%, arr, s As Worksheet
k = 1
For Each s In Sheets
    If s.Name <> "汇总" Then
       arr = s.Range("a1").CurrentRegion
       For i = 2 To UBound(arr)
          If arr(i, 1) = Sheets("汇总").[q12] Then
            Sheets("汇总").Cells(k + 1, "s") = s.Name
             k = k + 1
             For j = 1 To 18
             Sheets("汇总").Cells(k, j) = arr(i, j)
         
             Next
          End If
       Next
   End If
Next
End Sub

grf1973

方法四：

1. Sub test()
   
2.     Set cnn = CreateObject("ADODB.Connection")
   
3.     cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0';data source=" & ThisWorkbook.FullName
   
4.     For Each s In Sheets
   
5.         If s.Name <> "汇总" Then
   
6.             r = s.[r65536].End(3).Row
   
7.            Sql = Sql & " union all select 姓名,班级, 语文, 数学,英语,历史,政治,物理,化学,地理,生物,音乐,美术,信息,体育,口语,总分,年名,'" & s.Name & "' from [" & s.Name & "$a1:r" & r & "] where 姓名='" & Sheets("汇总").[q12] & " '"
   
8.         End If
   
9.     Next
   
10.     [a2:s10] = ""
    
11.     [a2].CopyFromRecordset cnn.Execute(Mid(Sql, 12))
    
12.     cnn.Close: Set cnn = Nothing
    
13. End Sub

复制代码

grf1973

疑问，为什么用 Sql = "select *,'2' from [2$a1:r6] where 姓名='付紫君 '" ，最后那个“2”会放到第一列？

grf1973

测试证明，Sql = "select 'kk',*,'aa' from [2$a1:r6] where 姓名='付紫君 '"，结果是
kk,aa,付紫君,...
用到select *，和其他常量，常量会放在首几列。

希望123456

grf1973 发表于 2023-5-16 14:36
测试证明，Sql = "select 'kk',*,'aa' from [2$a1:r6] where 姓名='付紫君 '"，结果是
kk,aa,付紫君,...
...

兄弟，你这是用的什么方法，论坛里麻烦给个教程学一下

jjmysjg

吴中泉 发表于 2023-5-15 16:28

这个代码能添加字段名称，就更完美了