Question

我正在尝试在一个工作簿中自动填充26个工作表上的日期系列。我有一份2014年的会计工作手册，我想在2015年设置。每个工作表都是一个工资表，每个工资期为两周。例如：Sheet1 $A$5:$A$9 week one＆amp; $A$11:$A$15 week two，Sheet2 $A$5:$A$9 week three＆amp; $A$11:$A$15 week four等等。我希望能够选择开始日期并使用系列autofill命令来填写整个工作簿中每个范围的日期。恰好相反，2015年第一个日期是2015年1月11日，最后一个日期是2016年1月9日。

修改

这是我目前的代码我必须重复最后6行24次，每次更改第1行和第3行的工作表参考。有没有办法缩短这个？

Sheets("pp03").Select  
myValue = InputBox("Enter Start Date")  
Range("A8").Value = myValue  
Range("A8:A14,A16:A22").Select  
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False  
Range("D9").Select  
Sheets("pp04").Select  
Range("A8").Select  
ActiveCell.FormulaR1C1 = "=pp03!R[14]C+1"  
Range("A8:A14,A16:A22").Select  
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False  
Range("D9").Select

Answer 1

警告：下面的宏将删除其工作簿中任何工作表的内容。

宏录制器是发现与键盘功能匹配的VBA语句的好方法，但它不能产生良好的代码。主要原因是它正逐一记录你的行为;它不知道你的目标。

如果您的VBA有限，我可以写一个宏来创造我想要的东西，而不是问很多可能没有多大意义的问题。在新工作簿中试用它并在必要时提出问题。

如果您要尝试编写宏，则必须学习VBA的基础知识。有许多在线教程：搜索“Excel VBA教程”。我更喜欢书。我访问了我当地的图书馆，借了一些Excel VBA Primers，然后买了我喜欢的那个。

Option Explicit
Sub SetDates()

  Dim DateStart As Date
  Dim DateEnd As Date
  Dim I As Long             ' Temporary integer
  Dim InxWsht As Long
  Dim RowCrnt As Long
  Dim StrStart As String
  Dim StrEnd As String
  Dim Title As String

  Title = "Fill worksheet with dates"

  StrStart = ""
  StrEnd = ""

  Do While True
    ' Loop until have acceptable start and end date

    Do While True
      ' Loop until have acceptable start date

      StrStart = InputBox("Please enter start date", Title, StrStart)
      If StrStart = "" Then
        ' User has pressed cancel
        Exit Sub
      End If
      If IsDate(StrStart) Then
        DateStart = CDate(StrStart)
        I = Weekday(DateStart, vbSunday)
        If I = vbSunday Then
          ' Have acceptable start date
          Exit Do
        End If
        Call MsgBox("Excel tells me " & StrStart & " is a " & _
                    WeekdayName(I, False, vbSunday) & _
                    " but I need a Sunday.  Please try again.", vbOKOnly, Title)
      Else
        Call MsgBox("Excel is unable to interpret " & StrStart & _
                    " as a date.  Please try again.", vbOKOnly, Title)
      End If
    Loop

    'Debug.Print StrStart & "->" & DateStart

    Do While True
      ' Loop until have acceptable end date

      StrEnd = InputBox("Start date is " & Format(DateStart, "dddd mmm, d yyyy") & _
                     "." & vbLf & "Please enter end date", Title, StrEnd)
      If StrEnd = "" Then
        ' User has pressed cancel
        Exit Sub
      End If
      If IsDate(StrEnd) Then
        DateEnd = CDate(StrEnd)
        I = Weekday(DateEnd, vbSunday)
        If I = vbSaturday Then
          ' Have acceptable end date
          Exit Do
        End If
        Call MsgBox("Excel tells me " & StrEnd & " is a " & WeekdayName(I, False, vbSunday) & _
                    " but I need a Saturday.  Please try again.", vbOKOnly, Title)
      Else
        Call MsgBox("Excel is unable to interpret " & StrEnd & _
                    " as a date.  Please try again.", vbOKOnly, Title)
      End If
    Loop

    Debug.Print StrEnd & "->" & DateEnd

    If DateStart < DateEnd Then
      Exit Do
    End If

    Call MsgBox("Start date " & StrStart & " is after end date " & _
                StrEnd & ".  Please try again.", vbOKOnly, Title)

  Loop

  ' Replace existing names of worksheets in case any existing name
  ' matches one I am able to create
  For InxWsht = 1 To Worksheets.Count
    Worksheets(InxWsht).Name = InxWsht
  Next

  InxWsht = 1

  Do While DateStart < DateEnd

    If InxWsht > Worksheets.Count Then
      ' There is no existing unused worksheet so create new
      ' one and place after any existing worksheets.
      Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=1
    End If

    With Worksheets(InxWsht)

      ' Delete any existing contents
      .Cells.EntireRow.Delete

      ' Name sheet for first day
      .Name = Format(DateStart, "mmm d")

      For RowCrnt = 3 To 9
        .Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
        DateStart = DateAdd("d", 1, DateStart)
      Next
      For RowCrnt = 11 To 17
        .Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
        DateStart = DateAdd("d", 1, DateStart)
      Next

      .Columns("A").AutoFit

    End With

    ' Advance to next worksheet
    InxWsht = InxWsht + 1

  Loop

End Sub

如何在多个工作表上定义范围以与自动填充一起使用

1 个答案: