Question

我将信息存储在一张Excel 2010工作簿中，其中一列包含日期。我想要一个宏，它将按日期对此信息进行分组，并将其复制到同一工作簿中的其他工作表中，我之前已经设置并按这些日期命名。

所以我在名为“Source”的表格上有这个信息：

Date         First Name  Last Name  Hair Colour
01/02/2011   Bob         Jones      Brown
02/05/2011   Geoff       Smith      Red
03/09/2010   Craig       Hamilton   Blond
02/05/2011   Chris       Wazowski   Brown
05/06/2011   Steve       Mac        Blond
03/09/2010   Tom         Lounds     Brown

我还有另外四张，名为：“2011年2月1日”，“2011年5月2日”，“2010年9月3日”和“2011年6月5日”

我想要一个宏来复制标题，并将“Source”表中包含这些日期的整行放到相应的表格中。

数据不断被添加到“源”表中，因此这是我需要经常重复的操作。

我知道这个网站上有很多代码可以显示如何按条件将信息分组并复制到其他工作表，但我还没有找到一个可以这样工作的代码。

Answer 1

以下是如何在Date（第一列中的数据）和String之间来回转换的示例，其格式与您的工作表名称相同。

Dim d As Date
Dim sheetName As String

d = CDate("01/02/2011") ' or e.g. Range("A2").Value
sheetName = Format(d, "dd mmm yyyy")

Debug.Print sheetName ' 01 Feb 2011

至于其他方面，正如您自己指出的那样，本网站已经回答了大量类似的问题，并提供与您几乎完全相同的问题的解决方案。一旦你尝试了一些东西，如果你遇到任何具体的问题，请告诉我们。

Answer 2

谢谢Jean-Francois。

我找到了一个效果很好的解决方案，虽然我不完全确定如何或为什么：

Sub Update_Sheets()

'Formats dates
Dim rng As Range
Dim rngA As Range

Set rngA = Range("A1:A" & Range("A" & Range("A:A").Rows.Count).End(xlUp).Row)
rngA.NumberFormat = "@"
For Each rng In rngA
    rng.Value = Format(rng, "dd mmm yyyy")
Next rng


'Copies rows of data to the right sheets
Dim ws As Worksheet, source As Range, dest As Range
Dim daily As Worksheet
Set daily = Worksheets("Source")
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In Worksheets
If ws.Name <> daily.Name Then
daily.Range("A1").AutoFilter Field:=1, Criteria1:=ws.Name
Set source = daily.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlVisible)
Set dest = Worksheets(ws.Name).Range("A65536").End(xlUp).Offset(1, 0)
source.Copy dest
End If
Next
daily.Range("A1").AutoFilter
On Error GoTo 0

End Sub

将数据行从一个工作表复制到另一个工作表，其中目标工作表按日期命名

2 个答案: