Question

我目前正在尝试拆分每个日期并为其制作单独的表格，我在选择每一天并将它们粘贴到单独的工作表时遇到一些麻烦。我决定将日期和时间分成单独的列，以便我更容易想象它。

感谢您的帮助。

＆＃39;它现在看起来如何

在运行代码之后应该如何看待它，不要在意B列和C列不同，因为它只是一个例子。

Sub CompareEachTime()

  Dim ws As Worksheet
  Dim Target As Range
  Dim results As Variant
  Dim x As Long
  Dim comp As Range
  Dim itter As Long
  Dim lastRow As Long

  Set ws = ActiveSheet

    With ws
     'my array
     Set Target = .Range("A5:AR10", .Cells(.Rows.Count, "A").End(xlUp))
     results = Target.Value2

    'find last cell
    lastRow = .Cells(.Rows.Count, "S").End(xlUp).Row

    itter = 1
    x = 1
    Do While itter < lastRow

    'compare date to see if it is equal comparing column B as it is date
    If (results(itter, 2) = results(itter + 1, 2)) Then

    itter = itter + 1

    Else
    'if different date copy the days and paste to new sheet
    'this is where I need help I think Select the date make new sheet then 
    'paste it to the new data sheet then go back to main sheet and do it 
    'till the end.

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = results(itter, 2)

    Worksheets(results(itter, 2)).Activate
    results(itter, 2).Paste
    ws.Select

    x = itter + 1

    End If

    Loop

    End With

End Sub

Answer 1

这就是我想出来的，你使用的方法有一些错误：

-Your LastRow最终返回第一行

- 您的代码似乎为每个选中日期打了一个新的工作表

- workheet.add方法无法与读/写属性.name结合使用（*尽我所能）*

我基本上重写了循环结构，只有在日期不匹配的情况下才添加新工作表....遗憾的是，您无法使用＆＃34; /＆＃34;来命名工作表。字符：C所以工作表名称类似于12272017而不是12/27/2017

另外，你想用时间显示日期吗？ .numberformat可以使用以下格式执行此操作：＆＃34; mm / dd / yyyy mm：ss＆＃34;

Sub SortDat_toSheet()
Dim x, y, i, n As Long
Dim wsNam As String
Dim Target, TDate, TRange As Range
Dim Results As Variant
Dim Wks As Worksheet

Set Wks = ActiveSheet
Set Target = Range("A1:D31", Cells(Rows.Count, "A").End(xlUp))
Results = Target.Value
Wks.Columns(1).NumberFormat = "mm/dd/yyyy  mm:ss"
n = 1             'set n to the column with the dates
x = UBound(Results, 1)
y = UBound(Results, 2)
Set TDate = Target(1, n)

For i = 1 To x
wsNam = Results(i, n)
wsNam = NamGen(wsNam)
If Not (i + 1) > x Then
    If Left(Results(i, n), 10) <> Left(Results(i + 1, n), 10) Then
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = wsNam
        Wks.Range(TDate.Address, Target(i, n)).Copy
        Sheets(wsNam).Range("a1").PasteSpecial xlPasteValuesAndNumberFormats
        Sheets(Sheets.Count).Columns(n).AutoFit
        Set TDate = Target(i + 1, n)
    End If
Else
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = wsNam
        Wks.Range(TDate.Address, Target(i, n)).Copy
        Sheets(wsNam).Range("a1").PasteSpecial xlPasteValuesAndNumberFormats
        Sheets(Sheets.Count).Columns(n).AutoFit
End If
Next i
Wks.Activate
Application.CutCopyMode = False
End Sub

Function NamGen(BadNam As String) As String
Dim i As Long
Dim xChar As String
xChar = ""
For i = 1 To 10
    If Mid(BadNam, i, 1) Like "[1234567890]" Then
        xChar = xChar & Mid(BadNam, i, 1)
    End If
Next i
NamGen = xChar
End Function

希望这有帮助！我对VBA有点新意; D

**所以我想你还需要转移的其他列来匹配日期列？我做了一个小技巧（在VBA中）：制作一个索引，匹配，匹配公式，将所有单元格的.value设置为该公式，它完成所有工作......然后将单元格复制并粘贴回来价值......快速容易;）

将日期分成新表

1 个答案: