您找到的代码是垃圾。我建议你不要再访问你得到它的网站。
“35536”应该是“65536”,但前提是代码是在 2007 年之前发布的。在 Excel 2007 之前,工作表中的最大行数为 65536。从那时起,您会被告知编写 Rows.Count 给出正在使用的 Excel 版本的每个工作表的行数。
首要任务是找到正确的列。您可以从 2015 年 1 月 1 日的列中搜索;对于每天只运行一次的宏,这是可以接受的。但是,我使用函数DatePart 来找到一个近似的起始列,然后向后或向前搜索正确的列。这有点OTT。我通常会推荐达到预期效果所需的最低限度,但我想向您展示一些可能性。
您找到的代码使用ActiveSheet。这可能是合适的,但很少是合适的。使用ActiveSheet 依赖于用户在启动宏时是否激活了正确的工作表。宏可能无法在错误的工作表中找到今天的日期,但最好是您的代码明确引用正确的工作表。
第 51 行可能是包含今天日期的行,但它总是正确的行吗?我已将该行作为第一个代码块的函数调用中的参数。将其定义为常量是另一种选择:
Const RowDate as Long = 51
我通常发现使用常量是解决此类问题的最佳方法。我的模块顶部有一个关于行、列和其他任何当前已修复但将来可能会更改的常量的列表。如果值发生变化,修改常量定义是完全更新宏所必需的。
我在工作表“每日”中设置了四行日期列表,但开始列不同,因此我可以测试函数中的所有存在点:
测试数据
下面的代码将其输出到即时窗口:
Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH
Option Explicit
Sub TestFindColToday()
Dim ColToday As Long
ColToday = FindColToday("Daily", 51)
Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 41)
Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 44)
Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 47)
Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)
End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long
Dim ColToday As Long
Dim Today As Date
Today = Date
ColToday = DatePart("y", Today) * 5 / 7
With Worksheets(WshtName)
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' This column is after the column for Today
' Move back until correct column found or does not exist
Do While True
ColToday = ColToday - 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value < Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
Else
' This column is before the column for Today
' Move forward until correct column found or does not exist
Do While True
ColToday = ColToday + 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
End If
End With
End Function
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
我认为您正在做的是将格式、值和公式向前复制一列,然后用它们的值覆盖昨天列中的公式。如果我错了,我相信有足够的信息可以让您将宏调整到您的确切要求。必要时带着问题回来,但你自己做的越多,你的发展就越快。
Sub CopyYesterdayToTodayAndFixYesterday()
' "Yesterday" is the last working day before today. For Tuesday to
' Friday this will be yesterday. For Monday it will Friday. This will
' not be true if columns are omitted for public holidays.
Const RowDate As Long = 51
Const RowCopyFirst As Long = 53
Const RowCopyLast As Long = 146
Const WshtTgtName As String = "Daily"
Dim ColToday As Long
Dim RngSrc As Range
ColToday = FindColToday("Daily", 51)
With Worksheets(WshtTgtName)
Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
Debug.Print RngSrc.Address
' Copy yesterday's formats, values and formulae to today
RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)
' Overwrite yesterday's formulae with value
RngSrc.Value = RngSrc.Value
End With
End Sub