Question

我正在开发一个电子表格，其中一个元素需要从当前列重复复制/粘贴到下一列，然后将值复制/粘贴回第一列。工作表中的列包含一年中每个工作日的数据。

我们的想法是将公式从昨天的专栏中移到今天的专栏中。这是每天早上开始将今天的数据输入工作表之前执行的过程的一部分。

理想情况下，公式将始终位于今天的列中，但昨天列中的数据应作为特殊值粘贴回来。

我需要一个宏来简化流程。

示例：

复制数据范围BM53:BM146
粘贴到BN53:BN146
复制数据范围BM53:BM146
将特殊值粘贴回BM53:BM146

第二天早上，当我运行宏时，应该

复制数据范围BN53:BN146
粘贴到BO53:BO146
复制数据范围BN53:BN146
将特殊值粘贴回BN53:BN146

等等每一天。

我通过在线搜索找到了以下代码。该代码用于电子表格中的行。我试图根据我的需要重做它，这是整个电子表格中的列，但是陷入了混乱。

代码：

Sub AddToNextRow() 
    Dim Count, LastRow As Integer 
    LastRow = Cells(35536, 3).End(xlUp).Row 
    For Count = 3 To 22 
        ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula 
        ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count) 
    Next Count 
End Sub

Answer 1

您似乎希望将公式从上次使用的列复制到新列中，然后将原始公式恢复为其值。

with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
    .copy destination:=.offset(0, 1)
    .value = .value
end with

您应该能够每天运行该操作以生成右侧的新公式列。我正在使用一定数量的行，但如果知道是什么改变了它们，那么每天都可以调整它们。

Answer 2

您找到的代码是垃圾。我建议你不要再访问你再次获得它的网站。

＆＃34; 35536＆＃34;应该是＆＃34; 65536＆＃34;但只有在2007年之前发布了代码。在Excel 2007之前，工作表中的最大行数为65536.从那时起，您将被告知要编写Rows.Count，它给出了Excel版本的每个工作表的行数。使用

第一项任务是找到正确的列。您可以从列中搜索2015年1月1日;对于每天只运行一次的宏，这是可以接受的。但是，我使用函数DatePart来查找近似的起始列，然后向后或向前搜索正确的列。这有点OTT。我通常会建议达到预期效果所需的最低限度，但我想向您展示一些可能性。

您找到的代码使用ActiveSheet。这可能是合适的，但很少。使用ActiveSheet依赖于用户在启动宏时激活了正确的工作表。宏可能无法在错误的工作表中找到今天的日期，但如果您的代码明确引用了正确的工作表，则会更好。

第51行可能是今天包含日期的行，但它始终是正确的行吗？我已经在第一个代码块的函数调用中使该行成为参数。将其定义为常量是另一种选择：

Const RowDate as Long = 51

我通常会发现对这类问题使用常量最佳方法。我的模块顶部的常量列表包含行，列和其他任何当前已修复但可能在将来更改的内容。如果值发生变化，修改常量定义就是完全更新宏所必需的。

我已在工作表“每日”中将四行设置为日期列表但具有不同的起始列，因此我可以测试该函数中的所有存在点：

TESTDATA

下面的代码将此输出到立即窗口：

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

在Excel中创建宏所需的VBA代码

2 个答案: