根据一列中的信息自动将一行从一张纸复制到另一张纸，并按日期排序（按月）

Question

好的，我遇到了一个问题，希望你们中的一个（或多个）能够帮助我。

一周以来，我一直在尝试研究如何根据第二列中日期的月份自动将工作簿中的一个工作表中的行复制和更新为单独的工作表。

我已经尝试了所有我能想到的方法，但 VLOOKUP 似乎没有做到这一点，而且我对 VBA 知之甚少，无法弄清楚它是如何工作的。

我确实找到了一个使用 VBA 看起来很有希望的解决方案，它根据其中一列中的不同值拆分所有不同的行（我创建了一个额外的列并将其格式化为文本，然后在 1 月 15 日、2 月 15 日等.) 然后创建新选项卡并将数据插入其中。不幸的是，由于某种原因，这最终导致创建了过多的选项卡，并且在我更改主表时不会更新细分表。

我找到的代码是：

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1        
Set ws = Sheets("Sheet1")        
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"            
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

现在，我真正想要的是让 excel 搜索 C 列中的日期，并根据月份将它们移动到相关工作表中，但如果我更新主工作表，每月工作表会自动更新。我不知道这是否可能，但肯定是（可能甚至不难）。如有必要，我很乐意在另一列中添加“1 月 15 日”、“2 月 15 日”等内容，或者提供一个我可以按下以更新所有内容的按钮。

任何帮助将不胜感激！

Answer 1

您的代码看起来有点矫枉过正，在这里我写了一段代码，如果扩展一点就可以完成这项工作，您需要添加一些案例，以防止出现错误，以防工作表已经存在，并进行调整粘贴位置，但它是一个开始（对你也有更多的学习价值）:)

Sub haha()

Dim ws As Worksheet
Dim i As Integer
Dim lastrow

Set ws = ActiveSheet
lastrow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

For i = 1 To lastrow

Select Case Format(ws.Range("c" & i).Value, "mm")

Case "01"

Sheets.Add.Name = "Jan"
ws.Range("C" & i).EntireRow.Copy Sheets("Jan").Range("A1")


End Select
Next i
End Sub

干杯

Answer 2

如果它是你想放在按钮上的代码，我会这样做：

dim b2 as Workbook
Set b2=ThisWorkbook

xrowx=1
datecol='whatever column that you have the "Feb15" "Jan 15" data in

Do While xrowx<=Worksheetfunction.CountA(b2.Sheets(1).Range("A:A"))


month=Left(b2.Sheet(1).cells(xrowx,datecol))

if month="Jan" then
    emptyrow=Worksheetfunction.CountA(b2.sheets(2).Range("A:A")+1

    col=1

    Do While col<=datecol
    b2.sheets(2).cells(emptyrow,col)=b2.Sheets(1).Cells(emptyrow,col)
    col=col+1

    Loop

elseif month="Feb" then
    emptyrow=Worksheetfunction.CountA(b2.sheets(3).Range("A:A")+1

    col=1

    Do While col<=datecol
    b2.sheets(3).cells(emptyrow,col)=b2.Sheets(1).Cells(emptyrow,col)
    col=col+1

    Loop

elseif ...

...'continue on in this manner for all months

xrowx=xrowx+1

Loop

它不是超级漂亮或完成它的最优化方式，但它很容易理解，并且应该为您提供一个体面的框架来构建适合您需求的东西（注意：此代码也可用于自动-作为内置工作表宏的一部分进行更新，但由于数据集非常大，它会有点迟钝，不建议这样做）