我要感谢所有在本网站上提供答案的人，感谢我能够从这个论坛获得的多年有用的信息。这是我发布的第一个问题：
问题在于：我编写了以下代码，以便创建一个连续的日历，我的同事可以填写并刷新到当天及以后。完成后，代码似乎工作，直到我使用第二个代码从另一个工作表引用此工作表。在拆开第一个代码后，我意识到简单地删除引用表中的任何单元格会导致第二个代码冻结。它将不断寻找表格，但从未找到它。我能够创建一个解决方法，代码在刷新宏上复制和粘贴，而不是删除任何单元格。但是我担心有人会在将来删除一个单元格并导致我的工作簿出现问题。
这是我的问题：是否存在重置变量或声明变量而无需关闭和打开工作簿的代码。
我尝试过的事情：不使用变量并直接引用工作表，在另一个工作簿和计算机上尝试相同的代码和环境。我尝试不删除范围B1，但即使删除没有vba的工作表1上的任何单元格也会导致代码2冻结。它将在工作簿保存，关闭并再次打开时重置。
表1中的代码1：
Sub OoDCalUpdate()
'
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim str As String
str = Range("A2")
On Error GoTo errHandler
iFind = Range("B1:CF1").Find(str).Column
Range(Cells(1, 2), Cells(100, iFind)).**Delete**
Range(Cells(1, 85 - iFind), Cells(2, 85 - iFind)).AutoFill Destination:=Range(Cells(1, 85 - iFind), Cells(2, 84)), Type:=xlFillSeries
errHandler:
Exit Sub
End Sub
如果您需要在表2中使用代码2，我将asterix放在我认为代码冻结的位置：
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.
' Clear area a1:g14 including any previous calendar.
Range("A1:O27").Clear
' Use InputBox to get desired month and year and set variable
' MyInput.
' Allow user to end macro with Cancel in InputBox.
**Dim ws As Worksheet
Dim str As String
Set ws = Worksheets("OoD Tracker")
str = Worksheets("OoD Tracker").Range("B1")**
'MONTH 1
' Get the date value of the beginning of inputted month.
StartDay = DateValue(str)
' 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
.Interior.ColorIndex = 33
End With
' Prepare a2:g2 for day of week labels with centering, size,
' height and bolding.
With Range("a2:g2")
.ColumnWidth = 15
.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(str, "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
'MONTH 2
' Get the date value of the beginning of inputted month.
StartDay = DateValue(str)
' 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 & "/1/" & _
Year(StartDay))
End If
' Prepare cell for Month and Year as fully spelled out.
Range("I1").NumberFormat = "mmmm yyyy"
' Center the Month and Year label across I1:O1 with appropriate
' size, height and bolding.
With Range("I1:O1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
.Interior.ColorIndex = 22
End With
' Prepare I2:O2 for day of week labels with centering, size,
' height and bolding.
With Range("I2:O2")
.ColumnWidth = 15
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
' Put days of week in I2:O2.
Range("I2") = "Sunday"
Range("J2") = "Monday"
Range("K2") = "Tuesday"
Range("L2") = "Wednesday"
Range("M2") = "Thursday"
Range("N2") = "Friday"
Range("O2") = "Saturday"
' Prepare I3:O7 for dates with left/top alignment, size, height
' and bolding.
With Range("I3:O8")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
' Put inputted month and year fully spelling out into "I1".
Range("I1").Value = Application.Text(StartDay, "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("I3").Value = 1
Case 2
Range("J3").Value = 1
Case 3
Range("K3").Value = 1
Case 4
Range("L3").Value = 1
Case 5
Range("M3").Value = 1
Case 6
Range("N3").Value = 1
Case 7
Range("O3").Value = 1
End Select
' Loop through range I3:O8 incrementing each cell after the "1"
' cell.
For Each cell In Range("I3:O8")
RowCell = cell.Row
ColCell = cell.Column
' Do if "1" is in first column.
If cell.Column = 9 And cell.Row = 3 Then
' Do if current cell is not in 1st column.
ElseIf cell.Column <> 9 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 9.
ElseIf cell.Row > 3 And cell.Column = 9 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("I4").Offset(x * 2, 0).EntireRow.Insert
With Range("I4:O4").Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Size = 12
.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("I3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Range("I3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("I3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range("I13").Value = "" Then Range("I13:O13").Offset(0, 0) _
.Resize(2, 8).Delete
'REST OF MONTH 1
' Create Entry cells, format them centered, wrap text, and border
' around days.
For x = 0 To 5
With Range("A4:G4").Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Size = 12
.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:G13").Offset(0, 0) _
.Resize(2, 8).Delete
Dim strMo As String
Dim MoRow As Integer
Dim MoCol As Integer
Dim DaRow As Integer
Dim DaCol As Integer
With Application.FindFormat.Font
.FontStyle = "Bold"
End With
For Counter = 2 To 84
tcell = ws.Cells(1, Counter)
strMo = DateValue(Month(tcell) & "/1/" & Year(tcell))
strDa = Format(tcell, "d")
MoRow = Range("A1:O30").Find(strMo, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True).Row
MoCol = Range("A1:O30").Find(strMo, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True).Column
DaRow = Range(Cells(MoRow, MoCol), Cells(MoRow + 14, MoCol + 6)).Find(strDa, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True).Row
DaCol = Range(Cells(MoRow, MoCol), Cells(MoRow + 14, MoCol + 6)).Find(strDa, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True).Column
Cells(DaRow + 1, DaCol).Value = "='OoD Tracker'!" & ws.Cells(2, Counter).Address
Next Counter
' 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
' Error causes msgbox to indicate the problem, provides new input box,
' and resumes at the line that caused the error.
MyErrorTrap:
MsgBox "Please check OoD Tracker sheet to ensure the dates are correct. See LitProd Data Help File for more information."
Exit Sub
End Sub
谢谢