当每周按一次按钮从另一张表导入日期时，如何在列中自动填充日期？

Posted 2023-02-24

【中文标题】当每周按一次按钮从另一张表导入日期时，如何在列中自动填充日期？

【英文标题】：How do you autofill dates in a column when a date is imported from another sheet by button press weekly?

【发布时间】：2018-07-10 15:39:16

【问题描述】：

我正在尝试在 VBA 中编写代码以将每周的 cmets 和一周开始的日期从一张 (ws1) 复制到第二张用于存储 (ws4)，自动填充一周的剩余日期，最后在工作表底部添加一个新行。

我可以让程序将 cmets 和日期从 ws1 复制到 ws4。他们应该进入相应的列。 但是，如果我再次按下它，它只会覆盖我的数据并在输入的日期下方添加一个日期。这就是为什么我认为如果我一直添加日期，那将解决这个问题。 我目前的问题是我无法获得代码（我相信应该可以）来自动填充我的日期。当我到达代码中的那一行时，出现以下错误： “运行时错误‘1004’： 应用程序定义或对象定义错误" 我试图弄清楚到底发生了什么，尽管我进行了研究和狩猎，但我似乎无法让它发挥作用。我不知道我是否在尝试错误地呼出某些东西，或者我正在做的事情是不可能的。

我考虑使用“If/Then/Else”参数来让事情正常工作，但我无法让它发挥得很好。我试图弄清楚的页面的链接是here。 然后我想到this 的帖子可能会提供更多的洞察力，因为它类似于我试图根据另一个输入的日期输入一个月（几乎是我的问题）。但是，这个选项对我也不起作用。 最后我得到了我目前的解决方案（这看起来简单易行）。 Here 是原始解决方案的链接，我的更改反映在我提供的代码中。

我不知道发生了什么以及从这里去哪里。下面你会看到我专门为这部分代码的缩短部分（它是一个更大的代码的一部分，减去这个部分）。

Private Sub CommandButton2_Click()

Dim ws1 As Worksheet: Set ws1 = Sheets("Weekly Job Progress")
Dim ws4 As Worksheet: Set ws4 = Sheets("Comment Storage")
Dim lrow2 As Long: lrow2 = ws4.Cells(Rows.Count, 1).End(xlUp).Row + 1

With ws1 
    'Copy the date to & from.
    ws4.Cells(lrow2, 1) = .Range("E3")
    For m = 7 To 13
        n = m - 4
        'Copy the days of the week
        ws4.Cells(n, 2) = .Range("I" & m)
        'Copy the comments entered
        ws4.Cells(n, 3) = .Range("K" & m)
    Next 
End With

With ws4 
    rowf = .Cells(Rows.Count, 1).End(xlUp).Row
    'Supposed to automatically populate the dates on ws4 up to the last row... Doesn't work.
    .Range("B:B" & rowf).Value = (rowf - 1)
    'Supposed to add a new row at the bottom of my sheet but doesn't (no clue why because the same code works on ws3 [not shown].)
    .Range("A" & lrow2 + 1).EntireRow.Insert
End With

End Sub

如果我在发布此内容时做错了什么，请告诉我，因为这是我第一次在此网站上发布内容，尽管在过去的几周里我已经将它用于我的研究和学习。 谢谢。

编辑 1： 清理了代码并记下它，希望能够更容易地理解我正在尝试做什么以及我的问题出在哪里。我还进行了 cmets 中提到的关于不使用与列相同字母的引用的更改。否则，我的代码不变。

【参考方案1】：

在你的第一个 with 块中，尽量不要将范围对象相互引用，而只是引用值。像这样：ws4.Cells(m, 3).value = .Range("K" & k).value

【讨论】：

谢谢。我可以看到对于具有多个引用的较长代码来说，这将是一个更大的问题。我会改变它，因为它是一个小改动，并记住它。

刚刚按照您的建议编辑了我的参考范围（对不起，我应该早点这样做）。我还清理了我的代码，希望它更容易理解。

您现在应该得到一些“Rows.Count”错误。这告诉 VBA 需要一个名为 rows 的具有计数属性的对象变量。我认为您需要引用工作表的行属性。看看这个msdn.microsoft.com/de-de/VBA/Excel-VBA/articles/…

我会在几个小时后到办公室时试一试。谢谢你。如果它没有引用我认为我要告诉它的内容，那可能就是我的部分问题所在。我还将查看我在该部分中的其余代码，以确保它也能配合。

【参考方案2】：

下面是最终工作的代码。它需要时间来清理并弄清楚。但是，在一些外部帮助下，这是可行的。它最终变成了一个 2 部分代码，让它玩得很好，但它解决了这个问题。

With ws1
    'Insert 7 Lines
    ws4.Range("A" & lrow2 + 2).EntireRow.Offset(1).Resize(6).Insert Shift:=xlDown
    'Copy the date to & from.
    ws4.Cells(lrow2 + 2, 1) = .Range("E3")
    For m = 7 To 13
        n = m - 4
        'Copy the day of the week.
        ws4.Cells(lrow2 + n - 1, 2) = .Range("I" & m)
        'Copy the comment entered.
        ws4.Cells(lrow2 + n - 1, 3) = .Range("K" & m)
    Next
End With

With ws4
    Dim rowf1 As Long: rowf1 = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim rowf2 As Long: rowf2 = .Range("B" & .Rows.Count).End(xlUp).Row
    'Defines the Destination of cells to AutoFill & the range area to stop at.
    .Range("A" & rowf1).AutoFill Destination:=.Range("A" & rowf1 & ":A" & rowf2)
    'To insert a new row at the end of my imported data to give a new line with the same formatting to start on at the next import.
    .Range("B" & rowf2 + 1).EntireRow.Insert
End With