[已解决]请教在多表中进行查找与引用

梦镜0314

请求帮助，我想将1店、2店等的表中的数据，汇总到后面的总表里，因为店数较多，请大家告诉我个简便的方法，谢谢了

最佳答案

月排行榜 / 总排行榜

过江龙

2011-12-7 17:25

写了一段代码，看看是不是你所要的。
Sub xrs()
Application.ScreenUpdating = False
Range("C3:J" & [B65536].End(xlUp).Row).ClearContents
Dim Sh As Worksheet
  For Each c In Range("A3:A" & [B65536].End(xlUp).Row)
   If c <> "" Then
     h = c.Value
     x = c.Row
      For Each Sh In Worksheets
        If Sh.Name = h Then
        Cells(x, 3) = Sh.Cells(4, 3)
        Cells(x + 1, 3) = Sh.Cells(5, 3)
        Cells(x, 4) = Sh.Cells(4, 4)
        Cells(x + 1, 4) = Sh.Cells(5, 4)
        Cells(x, 5) = Sh.Cells(4, 5)
        Cells(x + 1, 5) = Sh.Cells(5, 5)
        Cells(x, 6) = Sh.Cells(4, 6)
        Cells(x + 1, 6) = Sh.Cells(5, 6)
        Cells(x, 7) = Sh.Cells(4, 7)
        Cells(x + 1, 7) = Sh.Cells(5, 7)
        Cells(x, 8) = Sh.Cells(8, 1)
        Cells(x, 9) = Sh.Cells(8, 5)
        Cells(x, 10) = Sh.Cells(8, 6)
        End If
      Next
End If
Next c
Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

过江龙

无能为力，俺用滴是2003版的。

梦镜0314

我转换成了03的，麻烦帮我看看

梦镜0314

过江龙 发表于 2011-12-7 16:23
无能为力，俺用滴是2003版的。

我换成03的，麻烦帮我看看吧，谢谢

过江龙

写了一段代码，看看是不是你所要的。
Sub xrs()
Application.ScreenUpdating = False
Range("C3:J" & [B65536].End(xlUp).Row).ClearContents
Dim Sh As Worksheet
  For Each c In Range("A3:A" & [B65536].End(xlUp).Row)
   If c <> "" Then
     h = c.Value
     x = c.Row
      For Each Sh In Worksheets
        If Sh.Name = h Then
        Cells(x, 3) = Sh.Cells(4, 3)
        Cells(x + 1, 3) = Sh.Cells(5, 3)
        Cells(x, 4) = Sh.Cells(4, 4)
        Cells(x + 1, 4) = Sh.Cells(5, 4)
        Cells(x, 5) = Sh.Cells(4, 5)
        Cells(x + 1, 5) = Sh.Cells(5, 5)
        Cells(x, 6) = Sh.Cells(4, 6)
        Cells(x + 1, 6) = Sh.Cells(5, 6)
        Cells(x, 7) = Sh.Cells(4, 7)
        Cells(x + 1, 7) = Sh.Cells(5, 7)
        Cells(x, 8) = Sh.Cells(8, 1)
        Cells(x, 9) = Sh.Cells(8, 5)
        Cells(x, 10) = Sh.Cells(8, 6)
        End If
      Next
End If
Next c
Application.ScreenUpdating = True
End Sub

梦镜0314

过江龙 发表于 2011-12-7 17:25
写了一段代码，看看是不是你所要的。
Sub xrs()
Application.ScreenUpdating = False

非常感谢，改改后用途非常广