Question

我希望用重复数据填充电子表格，所以今天要进行25次约会，明天要进行25次约会，并尽可能使用相同的名称，依此类推。

这是一种简单的方法来填充表格，其中日期以25为单位递增吗？

Answer 1

尝试使用此功能，您可能可以实现所需的功能，任何问题都会大喊大叫

       '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

Answer 2

让我们假设：

我们使用Sheet1
公司列为D列
日期列是第一列

请尝试：

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

Excel-用日期块填充

2 个答案: