VBA宏 - 為生成的數據指定新工作表

Question

目前我有一段代碼可以開始和結束日期，並列出該日期范圍內的所有日期。 這允許我采取下表並將其拆分為各個日期。

|Name            | StartDate  | EndDate
|Bob The builder | 20/05/2015 | 24/05/2015 
|Tiny Tim        | 08/06/2015 | 09/06/2015
|Dolly Parton    | 06/08/2015 | 08/08/2015

但是，目前它將創建的數據直接轉儲到現有表下面，如下所示：

|Name            | StartDate  | EndDate
|Bob The builder | 20/05/2015 | 24/05/2015 
|Tiny Tim        | 08/06/2015 | 09/06/2015
|Dolly Parton    | 06/08/2015 | 08/08/2015
|Bob The builder | 20/05/2015 | 
|Bob The builder | 21/05/2015 |
|Bob The builder | 22/05/2015 | 
|Bob The builder | 23/05/2015 | 
|Bob The builder | 24/05/2015 | 
|Tiny Tim        | 08/06/2015 | 
|Tiny Tim        | 09/06/2015 | 
|Dolly Parton    | 06/08/2015 | 
|Dolly Parton    | 07/08/2015 |
|Dolly Parton    | 08/08/2015 |

我已經嘗試了幾種嘗試讓它在新工作表上找到它的方法，每次我用代碼搞砸都失敗了。 另請注意，復制生成的數據將不起作用，因為每次運行此宏時，原始表將具有不同的行數。 這是我一直在使用的代碼：

Sub SeparateDateRange()

Dim Ws As Worksheet
Dim nCol As Integer


Set Ws = ActiveSheet

nCol = 1 

Application.ScreenUpdating = False


For i = 1 To ActiveSheet.Cells(Rows.Count, nCol + 2).End(xlUp).Row - 1 Step 1 

    For j = 0 To Ws.Cells(i + 1, nCol + 2).Value - Ws.Cells(i + 1, nCol + 1).Value Step 1 

  With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    For k = 0 To nCol - 1 Step 1
        .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
    Next k

    .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
    End With

    Next j
Next i

Application.ScreenUpdating = True

End Sub

Answer 1

您遇到的問題來自於您將生成的值放在Ws的偏移處，您已將其定義為活動工作表Set Ws = ActiveSheet

這反映在這里：

With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
For k = 0 To nCol - 1 Step 1
    .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
Next k

    .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
End With   

而不是使用活動工作表，定義一個新工作表以插入值並在您的With引用它，例如：

Dim newWS as worksheet
Set newWS = Sheets("SheetName")

With newWS.Cells(newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row + 1, 1)

這應該會讓你走上正軌。