0

无法弄清楚如何水平填充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

输出

4

2 回答 2

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

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

于 2019-09-03T14:57:03.917 回答
0

尝试使用公式来获取日期和星期。但是，单元格的合并需要一个循环。

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
于 2019-09-03T15:19:17.000 回答