将IF函数插入Excel日历宏的条目单元格中

时间:2013-02-18 21:51:59

标签: excel-vba vba excel

这是两部分问题。

我想使用宏(由Microsoft提供,因为我根本不知道VBA)根据用户提供的月份和年份填充月历。代码如下: Sub CalendarMaker()

   ' Unprotect sheet if had previous calendar to prevent error.
   ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
      Scenarios:=False
   ' Prevent screen flashing while drawing calendar.
   Application.ScreenUpdating = False
   ' Set up error trapping.
   On Error GoTo MyErrorTrap
   ' Clear area a1:g14 including any previous calendar.
   Range("a1:g14").Clear
   ' Use InputBox to get desired month and year and set variable
   ' MyInput.
   MyInput = InputBox("Type in Month and year for Calendar ")
   ' Allow user to end macro with Cancel in InputBox.
   If MyInput = "" Then Exit Sub
   ' Get the date value of the beginning of inputted month.
   StartDay = DateValue(MyInput)
   ' Check if valid date but not the first of the month
   ' -- if so, reset StartDay to first day of month.
   If Day(StartDay) <> 1 Then
       StartDay = DateValue(Month(StartDay) & "/1/" & _
           Year(StartDay))
   End If
   ' Prepare cell for Month and Year as fully spelled out.
   Range("a1").NumberFormat = "mmmm yyyy"
   ' Center the Month and Year label across a1:g1 with appropriate
   ' size, height and bolding.
   With Range("a1:g1")
       .HorizontalAlignment = xlCenterAcrossSelection
       .VerticalAlignment = xlCenter
       .Font.Size = 18
       .Font.Bold = True
       .RowHeight = 35
   End With
   ' Prepare a2:g2 for day of week labels with centering, size,
   ' height and bolding.
   With Range("a2:g2")
       .ColumnWidth = 20
       .VerticalAlignment = xlCenter
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Orientation = xlHorizontal
       .Font.Size = 12
       .Font.Bold = True
       .RowHeight = 20
   End With
   ' Put days of week in a2:g2.
   Range("a2") = "Sunday"
   Range("b2") = "Monday"
   Range("c2") = "Tuesday"
   Range("d2") = "Wednesday"
   Range("e2") = "Thursday"
   Range("f2") = "Friday"
   Range("g2") = "Saturday"
   ' Prepare a3:g7 for dates with left/top alignment, size, height
   ' and bolding.
   With Range("a3:g8")
       .HorizontalAlignment = xlRight
       .VerticalAlignment = xlTop
       .Font.Size = 18
       .Font.Bold = True
       .RowHeight = 21
   End With
   ' Put inputted month and year fully spelling out into "a1".
   Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
   ' Set variable and get which day of the week the month starts.
   DayofWeek = Weekday(StartDay)
   ' Set variables to identify the year and month as separate
   ' variables.
   CurYear = Year(StartDay)
   CurMonth = Month(StartDay)
   ' Set variable and calculate the first day of the next month.
   FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
   ' Place a "1" in cell position of the first day of the chosen
   ' month based on DayofWeek.
   Select Case DayofWeek
       Case 1
           Range("a3").Value = 1
       Case 2
           Range("b3").Value = 1
       Case 3
           Range("c3").Value = 1
       Case 4
           Range("d3").Value = 1
       Case 5
           Range("e3").Value = 1
       Case 6
           Range("f3").Value = 1
       Case 7
           Range("g3").Value = 1
   End Select
   ' Loop through range a3:g8 incrementing each cell after the "1"
   ' cell.
   For Each cell In Range("a3:g8")
       RowCell = cell.Row
       ColCell = cell.Column
       ' Do if "1" is in first column.
       If cell.Column = 1 And cell.Row = 3 Then
       ' Do if current cell is not in 1st column.
       ElseIf cell.Column <> 1 Then
           If cell.Offset(0, -1).Value >= 1 Then
               cell.Value = cell.Offset(0, -1).Value + 1
               ' Stop when the last day of the month has been
               ' entered.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                   ' Exit loop when calendar has correct number of
                   ' days shown.
                   Exit For
               End If
           End If
       ' Do only if current cell is not in Row 3 and is in Column 1.
       ElseIf cell.Row > 3 And cell.Column = 1 Then
           cell.Value = cell.Offset(-1, 6).Value + 1
           ' Stop when the last day of the month has been entered.
           If cell.Value > (FinalDay - StartDay) Then
               cell.Value = ""
               ' Exit loop when calendar has correct number of days
               ' shown.
               Exit For
           End If
       End If
   Next

   ' Create Entry cells, format them centered, wrap text, and border
   ' around days.
   For x = 0 To 5
       Range("A4").Offset(x * 2, 0).EntireRow.Insert
       With Range("A4:G4").Offset(x * 2, 0)
           .RowHeight = 65
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlTop
           .WrapText = True
           .Font.Size = 10
           .Font.Bold = False
           ' Unlock these cells to be able to enter text later after
           ' sheet is protected.
           .Locked = False
       End With
       ' Put border around the block of dates.
       With Range("A3").Offset(x * 2, 0).Resize(2, _
       7).Borders(xlLeft)
           .Weight = xlThick
           .ColorIndex = xlAutomatic
       End With

       With Range("A3").Offset(x * 2, 0).Resize(2, _
       7).Borders(xlRight)
           .Weight = xlThick
           .ColorIndex = xlAutomatic
       End With
       Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
          Weight:=xlThick, ColorIndex:=xlAutomatic
   Next
   If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
      .Resize(2, 8).EntireRow.Delete
   ' Turn off gridlines.
   ActiveWindow.DisplayGridlines = False
   ' Protect sheet to prevent overwriting the dates.
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
      Scenarios:=True

   ' Resize window to show all of calendar (may have to be adjusted
   ' for video configuration).
   ActiveWindow.WindowState = xlMaximized
   ActiveWindow.ScrollRow = 1

   ' Allow screen to redraw with calendar showing.
   Application.ScreenUpdating = True
   ' Prevent going to error trap unless error found by exiting Sub
   ' here.
   Exit Sub

'错误导致msgbox指示问题,提供新的输入框,    '并在导致错误的行恢复。 MyErrorTrap:        MsgBox“您可能没有正确输入月份和年份。” _            &安培; Chr(13)&amp; “正确拼写月份”_            &安培; “(或使用3个​​字母的缩写)”_            &安培; Chr(13)&amp; “和4年的数字”        MyInput = InputBox(“为日历键入月份和年份”)        如果MyInput =“”那么退出Sub        恢复    结束子

但是我需要添加一个函数,将工作簿中另一个工作表的副本插入到上面的代码中定义为条目(“A4:G4”)的条目单元格中。偏移量(x * 2,0),当宏运行。另一张纸的副本是当天自助餐厅的食品,取决于当月的第一天。我已经构建了下面的函数,但不知道如何让它重复每个条目单元格(由单元格A3:G3,A5:G5,A7:G7,A9:G9和A11:G11确定)而不仅仅是找到并替换所有这些(我熟悉JavaScript,所以我假设一个数组可以用于此?)并且适合我正在尝试使用的宏,因为如果我将它放入单元格中日历视图工作表在运行宏时会被覆盖。

= IF(E3 = 1,'菜单项'!B2,IF(E3 = 2,'菜单项'!B3,IF(E3 = 3,'菜单项'!B4,IF(E3 = 4,'菜单项'!B5,IF(E3 = 5,'菜单项'!B6,IF(E3 = 6,'菜单项'!B7,IF(E3 = 7,MenuItems!B8,IF(E3 = 8,'菜单)项目'!B9(IF E3 = 9,'菜单项'!B10,IF(E3 = 10,'菜单项'!B11,IF(E3 = 11,'菜单项'!B12,IF(E3 = 12,'菜单项'!B13,IF(E3 = 13,'菜单项'!B14,IF(E3 = 14,'菜单项'!B15,IF(E3 = 15,'菜单项'!B16,IF(E3 = 16) ,'菜单项'!B17,IF(E3 = 17,'菜单项'!B18,IF(E3 = 18,'菜单项'!B19,IF(E3 = 19,'菜单项'!B20,IF(E3) = 20,'菜单项'!B21,IF(E3 = 21,'菜单项'!B22,IF(E3 = 22,'菜单项'!B23,IF(E3 = 23,'菜单项'!B24,IF (E3 = 24,'菜单项'!B25,IF(E3 = 25,'菜单项'!B26,IF(E3 = 26,'菜单项'!B27,IF(E3 = 27,'菜单项'!B28 ,IF(E3 = 28,'菜单项'!B29,IF(E3 = 29,'菜单项'!B30,IF(E3 = 30,'菜单项'!B31,IF(E3 = 31,'菜单项'' !B32,IF(E3 = 0,“”))))))))))))))))))))))))))))))))

非常感谢!

0 个答案:

没有答案