【问题标题】:VBA code required to create a Macro in Excel在 Excel 中创建宏所需的 VBA 代码
【发布时间】:2015-03-29 22:43:45
【问题描述】:

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

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

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

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

例子:

  1. 复制数据范围BM53:BM146
  2. 粘贴到BN53:BN146
  3. 复制数据范围BM53:BM146
  4. 将特殊值粘贴回BM53:BM146

第二天早上,当我运行宏时,它应该会

  1. 复制数据范围BN53:BN146
  2. 粘贴到BO53:BO146
  3. 复制数据范围BN53:BN146
  4. 将特殊值粘贴回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

【问题讨论】:

  • 嘿 BK -- 欢迎来到 Stack Overflow!你已经很好地确定了你需要做什么,有些人会说一个明确定义的问题已经完成了一半。您能向我们展示您到目前为止所做的尝试吗?
  • 谢谢丹。我在谷歌搜索中发现了以下内容。它完全符合我的要求,但代码适用于电子表格中的行,我想要整个电子表格中的列的代码。我试图重做它,但一团糟。
  • @user4727612。您的规范说您希望有一天将数据从 BM 列复制到 BN,然后在下一天将 BN 复制到 BO。宏如何知道哪个是源列?运行宏时,源列是工作表中最后使用的列吗?
  • BM = 昨天的日期。 BN = 今天的日期。 BO = 每列的明天日期等等。列的日期是一年中的每个工作日。我想要一个可以每天早上运行的宏。把昨天复制到今天。然后复制昨天并将值粘贴回昨天。然后我今天有公式等待计算我的输入。附加说明:在回答您的 Q 时,源列将不是宏运行后工作表中最后使用的列。
  • 你还没有说宏是如何知道哪个是源列。你所说的只是它每天增加一个。你说这些列已经过时了。宏可以沿一行查找今天的日期吗?

标签: excel vba


【解决方案1】:

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

“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

【讨论】:

  • @user4727612。如果您针对您的问题发表评论,那么您想阅读它的人只有在您的名字前面加上 @ 时才会知道它的存在。这是我的答案,所以我会自动被告知任何针对它发布的 cmets。
  • @user4727612。你会发现在不了解 VBA 基础的情况下理解代码的 sn-ps 非常困难。在网上搜索“Excel VBA 教程”。有很多可供选择,所以尝试一些并完成您喜欢的一个。我更喜欢书。我参观了一个图书馆,查看了他们的 Excel VBA 入门书,借了最好的在家里尝试,然后买了我最喜欢的一本作为永久参考。您会发现花在学习基础知识上的时间很快就会得到回报。
  • @user4727612。有一些我不打算讨论的例外情况。否则:是的,您的代码必须在模块内,并且必须在子或函数内。创建工作簿的副本,这样您就可以在不损坏任何东西的情况下进行试验。将我的第一个代码块复制到模块中。在Sub TestFindColToday 中删除测试可选日期行的最后六行。运行Sub TestFindColToday。它输出到即时窗口的行是否标识了正确的列?如果是这样,请尝试我的第二个代码块。 Sub CopyYesterdayToTodayAndFixYesterday 做你想做的事吗?
  • 欣赏指导。不幸的是,我再次对我的问题发表了回复/评论。昨天第一次在网站上注册并找到了我的路。
  • @user4727612。我明白;关于使用本网站的最佳方式,有很多东西需要学习。在页面顶部的右侧,您会找到help center。该按钮后面有很多建议,您会发现它们很有帮助。
【解决方案2】:

您似乎想将最后使用的列中的公式复制到新列中,然后将原始公式中的公式恢复为它们的值。

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

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

【讨论】:

    猜你喜欢
    • 2013-05-20
    • 2021-07-25
    • 1970-01-01
    • 1970-01-01
    • 2017-07-19
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多