时间戳

首页 > 解决方案 > 开始日期和结束日期填充水平

excel - 开始日期和结束日期填充水平

问题描述

无法弄清楚如何水平填充excel单元格......我在单元格“B2”中有“开始日期”，在单元格B3中有“结束日期”。

当我输入 2 个日期时，我只是用该范围内的日期填充所有单元格，但我垂直填充它们。我想水平填充它们

这是一张图片

在此处输入图像描述

"数据 inizio" --> 开始日期 "数据正常" --> 结束日期

这是我到目前为止所做的

    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

输出

标签： excelvbadate

解决方案

那这个呢 ？

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)将浏览第 4 列的行

Cells(4,Column)将浏览第 4 行的列

推荐阅读