Excel - заполнить блоками дат

Question

Я хочу заполнить электронную таблицу данными, повторяющими данные, поэтому 25 встреч на сегодня, 25 встреч на завтра с тем же именем и так далее, насколько это возможно.

Это простой способзаполнение таблицы, где дата увеличивается в блоках по 25?

Пример того, что я пытаюсь сделать

Answer 1

Предположим, что:

1. Мы используем Sheet1
2. Столбец компании - это столбец D
3. Столбец даты - это столбец I

Pease try:

Option Explicit

    Sub Test()

        Dim Lastrow As Long, i As Long

        With ThisWorkbook.Worksheets("Sheet1")
            Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
            For i = 2 To Lastrow
                If i = 2 Then
                    .Cells(i, 9).Value = Date + 1
                ElseIf i <> 2 And .Cells(i, 4).Value = 1 Then
                        .Cells(i, 9).Value = .Cells(i, 9).Offset(-1, 0).Value + 1
                Else: .Cells(i, 9).Value = .Cells(i, 9).Offset(-1, 0).Value
                End If

            Next i

        End With

    End Sub

Answer 2

Попробуйте использовать это, вы можете достичь желаемого, выкрикивать любые проблемы

       'to change the date to the next day
       Public Function ExtraDay(strDate As String)
       Dim tDay As Date
       tDay = Format(DateAdd("d", 1, strDate), "dd/mm/yy")
       ExtraDay = tDay

        End Function

       'gets the last used row
        Function getThelastUsedRowAddress() As Integer
        'Get Last Row in Worksheet UsedRange
         Dim LastRow As Range, ws As Worksheet
         Set ws = ActiveSheet
          MsgBox ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row

          getThelastUsedRowAddress = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
          End Function

          'button command on the sheet
           Private Sub CommandButton1_Click()
            Dim n, t As Integer
            Dim ns As String
            n = getThelastUsedRowAddress()
            t = n + n
            ns = CStr(t)
            Call getThelastUsedRow(CStr(n))
             Call TheLoopRange(CStr(n) + 1, ns)
             End Sub

           'get the last used and paste after
            Sub getThelastUsedRow(address As String)
           'Get Last Row in Worksheet UsedRange
             Dim LastRow As Range, ws As Worksheet
             Dim numcopied As Integer
            Dim numonpaper As Integer
            Set ws = ActiveSheet
             numcopied = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
               numonpaper = numcopied + 1
               ws.UsedRange.Copy 'Destination:=Wst.Cells(1, 1)

               'paste
                Sheets("Sheet1").Range("A" & numonpaper).PasteSpecial xlPasteValues

                 End Sub
                 'loop the pasted range and change date to the next day from date
                  Sub TheLoopRange(rangestart As String, rangeend As String)
                    'rangestart,rangeend
                  Dim rCell As Range
                  Dim rRng As Range

                  Set rRng = Sheet1.Range("E" & rangestart & ":E" & rangeend)

                 For Each rCell In rRng.Cells
                'MsgBox rCell.Value
                  rCell.Value = ExtraDay(rCell.Value)
                   Next rCell

                    End Sub