開始日期和結束日期水平填充

Question

無法弄清楚如何水平填充excel單元格...我在單元格“ B2”中具有“開始日期”，在單元格B3中具有“結束日期”。

當我輸入2個日期時，我只填寫了該范圍內所有日期的單元格，但垂直填寫了它們。 我想水平填充

這是一張照片

“ Data inizio”->開始日期“ Data fine”->結束日期

這是我到目前為止所做的

    Sub FillCal()

    ' Disable screen updates (such as warnings, etc.)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim StartD As Date, EndD As Date
    Dim prova As Integer
    Dim rngMerge As Range, rngCell As Range, mergeVal As Range
    Dim i As Integer
    Dim wks As Worksheet
    StartD = Foglio1.Cells(2, 2)
    EndD = Foglio1.Cells(3, 2)
    For Column = 1 To EndD - StartD
        Cells(4, Column) = StartD + Column - 1
        prova = Application.WorksheetFunction.WeekNum(StartD + Column - 1, 2)
        Cells(5, Column).NumberFormat = prova
        Cells(5, Column).Value = prova
    Next Column

    Set wks = ThisWorkbook.Sheets("Foglio1") ' Change Sheet1 to your worksheet

    i = wks.Range("E1").End(xlDown).Row
    Set rngMerge = wks.Range("E1:E" & i) ' Find last row in column A

    With wks
    ' Loop through Column A
checkAgain:
    For Each rngCell In rngMerge
        ' If Cell value is equal to the cell value below and the cell is not empty then
        If rngCell.Value = rngCell.Offset(1, 0).Value And IsEmpty(rngCell) = False Then
            ' Define the range to be merged
            ' Be aware that warnings telling you that the 2 cells contain 2 differen values will be ignored
            ' If you have 2 different sums in column C, then it will use the first of those
            '  Set mergeVal = wks.Range(rngCell.Offset(0, 2), rngCell.Offset(1, 2))
            '    With mergeVal
            '    .Merge
            '    .HorizontalAlignment = xlCenter
            '    .VerticalAlignment = xlCenter
            '    End With
            Range(rngCell, rngCell.Offset(1, 0)).Merge
            rngCell.VerticalAlignment = xlCenter
            GoTo checkAgain
        End If

    Next
    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

產量

Answer 1

那這個呢 ？

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim StartD As Date, EndD As Date
Dim prova As Integer
Dim rngMerge As Range, rngCell As Range, mergeVal As Range
Dim i As Integer
Dim wks As Worksheet
StartD = Foglio1.Cells(2, 2)
EndD = Foglio1.Cells(3, 2)
For Column = 1 To EndD - StartD
    Cells(4, Column) = StartD + Column - 1
    prova = Application.WorksheetFunction.WeekNum(StartD + Column - 1, 2)
    Cells(5, Column).NumberFormat = prova
    Cells(5, Column).Value = prova
Next Column

注意 ：

Cells(Column,4)將瀏覽Cells(Column,4)列的行

Cells(4,Column)將瀏覽第4行的列

Answer 2

嘗試使用公式獲取日期和星期。 但是，單元的合並將需要一個循環。

Sub TEST_2A()
Dim dIni As Double, dEnd As Double

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("DATA")    'change as required
        dIni = .Cells(2, 2)
        dEnd = .Cells(3, 2)

        With .Cells(3, 4).Resize(2, 1 + dEnd - dIni)
            .Cells(1).Value2 = dIni
            .Cells(2).Resize(1, -1 + .Columns.Count).FormulaR1C1 = "=+RC[-1]+1"
            .Rows(1).NumberFormat = "dd\/mm\/yyyy" 'change as required
            .Rows(2).FormulaR1C1 = "=WEEKNUM(R[-1]C,2)"
            .Value2 = .Value2

    End With: End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    End Sub