多个sheet的数据合并到一个表格,然后用公式点击日期能实际看相应该的数据
这是一个客户数据表,我每一个人用了一个sheet,然后我想自动汇总表一个表里面,点击日期可以实现每天销售人员的拜访门店数据基础数据表每列是样的,后面也有日期,那一个日期拜访发那一家店,我在相应行后面标了1。
用VBA写成吧,代码如下:
一、表格合并代码如下:
Sub mymerge() Application.DisplayAlerts = False On Error Resume Next Dim sh As Worksheet Dim ar, br(1 To 30000, 1 To 4), cr Dim x, y, j, i cr = Sheet1.Range("a1:d1") Sheets("汇总表").Delete For x = 1 To Sheets.Count If Sheets(x).Name <> "查询表" Then ar = Sheets(x).Range("a2:d" & Sheets(x).Range("a30000").End(3).Row) For y = 1 To UBound(ar) j = j + 1 br(j, 1) = j For i = 2 To 4 br(j, i) = ar(y, i) Next Next End If Next Set sh = Worksheets.Add(before:=Sheets(1)) sh.Name = "汇总表" sh.Range("a1").Resize(1, 4) = cr sh.Range("a2").Resize(j, 4) = br Application.DisplayAlerts = True End Sub
二、查询代码如下:
Sub info() Dim ar, br(1 To 1000, 1 To 2) Dim x, y ar = Sheets("汇总表").Range("a2:d" & Sheets("汇总表").Range("a30000").End(3).Row) For x = 1 To UBound(ar) If ar(x, 2) = Sheets("查询表").Range("a2") Then y = y + 1 br(y, 1) = ar(x, 3) br(y, 2) = ar(x, 4) End If Next If y = "" Then MsgBox ("没有此日期的内容,请重新输入日期!") End End If With Sheets("查询表") .Range("b2:c1000") = "" .Range("b2").Resize(y, 2) = br End With End Sub
三、代码的表格结构如下: