[已解决]请教，关于多表汇总的两个问题

mickol

需要实现两个功能，一是将两个数据表汇总成一个，二是可以按日期汇总。请各位老师多多帮忙。谢谢。

详见附件。

7j3SVY1c.rar (2.6 KB, 下载次数: 10)

2010-11-15 16:50 上传

点击文件名下载附件
请教，关于多表汇总的两个问题

最佳答案

月排行榜 / 总排行榜

FookYou

2010-11-15 19:41

LvJm0jr3.rar (10.01 KB, 下载次数: 15)

2010-11-15 19:41 上传

点击文件名下载附件
请教，关于多表汇总的两个问题
Sub 汇总()
  Dim Arr, k&
    Range("A6:D65536").ClearContents
    Arr = Sheet2.Range("A3:D" & Sheet2.[a65536].End(xlUp).Row)
    [A6].Resize(UBound(Arr), 4) = Arr
    Arr = Sheet3.Range("A3:D" & Sheet3.[a65536].End(xlUp).Row)
    k = [a65536].End(xlUp).Row
    Cells(k + 1, 1).Resize(UBound(Arr), 4) = Arr
    Range("A6:A" & k + UBound(Arr)).FormulaR1C1 = "=Row()-5"
End Sub
Sub 查找()
  Dim Arr, i&, k&, Sdate$, Sname$
    Sdate = [I4]
    Sname = [K4]
    Range("H6:K65536").ClearContents
    Arr = Sheet2.Range("B3:D" & Sheet2.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
    Arr = Sheet3.Range("B3:D" & Sheet3.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
End Sub

跳转到最佳答案楼层

Thenea

等高手~~

[此贴子已经被作者于2010-11-15 19:12:41编辑过]

FookYou

LvJm0jr3.rar (10.01 KB, 下载次数: 15)

2010-11-15 19:41 上传

点击文件名下载附件
请教，关于多表汇总的两个问题
Sub 汇总()
  Dim Arr, k&
    Range("A6:D65536").ClearContents
    Arr = Sheet2.Range("A3:D" & Sheet2.[a65536].End(xlUp).Row)
    [A6].Resize(UBound(Arr), 4) = Arr
    Arr = Sheet3.Range("A3:D" & Sheet3.[a65536].End(xlUp).Row)
    k = [a65536].End(xlUp).Row
    Cells(k + 1, 1).Resize(UBound(Arr), 4) = Arr
    Range("A6:A" & k + UBound(Arr)).FormulaR1C1 = "=Row()-5"
End Sub
Sub 查找()
  Dim Arr, i&, k&, Sdate$, Sname$
    Sdate = [I4]
    Sname = [K4]
    Range("H6:K65536").ClearContents
    Arr = Sheet2.Range("B3:D" & Sheet2.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
    Arr = Sheet3.Range("B3:D" & Sheet3.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
End Sub

sunjing-zxl

学习了

jljl

没看懂怎么解决的

mickol

QUOTE:

以下是引用FookYou在2010-11-15 19:41:00的发言：

Sub 汇总()
  Dim Arr, k&
    Range("A6:D65536").ClearContents
    Arr = Sheet2.Range("A3:D" & Sheet2.[a65536].End(xlUp).Row)
    [A6].Resize(UBound(Arr), 4) = Arr
    Arr = Sheet3.Range("A3:D" & Sheet3.[a65536].End(xlUp).Row)
    k = [a65536].End(xlUp).Row
    Cells(k + 1, 1).Resize(UBound(Arr), 4) = Arr
    Range("A6:A" & k + UBound(Arr)).FormulaR1C1 = "=Row()-5"
End Sub
Sub 查找()
  Dim Arr, i&, k&, Sdate$, Sname$
    Sdate = [I4]
    Sname = [K4]
    Range("H6:K65536").ClearContents
    Arr = Sheet2.Range("B3:D" & Sheet2.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
    Arr = Sheet3.Range("B3:D" & Sheet3.[b65536].End(xlUp).Row)
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = Sdate And Arr(i, 3) = Sname Then
        k = k + 1
        With [H5]
          .Offset(k, 0) = k
          .Offset(k, 1) = Arr(i, 1)
          .Offset(k, 2) = Arr(i, 2)
          .Offset(k, 3) = Arr(i, 3)
        End With
      End If
    Next
End Sub

谢谢FookYou老师的帮助，这个很实用，帮了我一大忙。想控制汇总的行数和查找的行数可以吗？

我为卿狂7219

如果要按工作内容查找怎么改呢，或者更多列怎么查找？请指教

松儿

好实用的

松儿

谢谢FookYou老师的帮助，这个很实用，帮了我一大忙。想控制汇总的行数和查找的行数可以吗？

wufengnokia

暂时看不懂呢