Question

我可以把一个体面的宏拉到一起，做我需要的但是我忘了每天都会改变范围具体来说，行数会更高。现在我的宏经历了隐藏任何没有今天日期的行，然后将一个范围复制到另一个工作簿中的工作表。我唯一的问题是范围每天都会改变，所以我想我只需要隐藏其余部分就可以复制包含数据的行，然后将它们粘贴到另一个工作簿中。

Sub automate()
Dim cell As Range
For Each cell In Range("AB2:AB30000")
If cell.Value < Date And cell.Value <> Empty Then cell.EntireRow.Hidden = True
Next
   Range("K28336:K28388,O28336:O28388,P28336:P28388,Q28336:Q28388,R28336:R28388,S28336:S28388,T28336:T28388,U28336:U28388,V28336:V28388,Y28336:Y28388,AA28336:AA28388,AB28336:AB28388").Select
Selection.Copy
Workbooks.Open ("\\gvwac09\Public\Parts\Test\2014 IPU.xlsx")
Sheets("Historical Data").Activate
ActiveSheet.Range("c1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Paste

到目前为止，这是我的宏。如果我没有正确格式化这篇文章，我很抱歉，对此不熟悉。

Answer 1

我不明白你在尝试什么，但我相信我可以给你一些有用的指示。

我没有解释我在下面的代码中使用的语句。在Visual Basic编辑器的帮助中查找它们或尝试在Web上搜索“Excel VBA xxxxx”。如有必要，请回答问题，但是你自己发现的越多，你的技能发展得越快。

首先，您需要找到包含数据的最后一行。检查每行到AB30000只是浪费时间。下面的宏Demo1演示了两种技术。有更多的技术可以找到最后一行，但在所有情况下都不适合。搜索StackOverflow“[excel-vba]查找最后一行”。虽然我使用的第一种技术是最受欢迎的，但是有很多相关的问题和答案。

一般建议：如果您可以将需求分解为一系列单个问题（例如“查找最后一行”），您会发现在StackOverflow中搜索答案会更容易。

如果要修改工作表，请始终在宏的开头包含Application.ScreenUpdating = False。如果没有此声明，每次隐藏行时，Excel都会重新绘制屏幕。

我创建了一些测试数据，希望能代表您的数据。我有两个工作表Source和Dest。 Source包含完整的数据集。我将选定的行复制到Dest。

我使用了自动过滤器，如果它能为您提供所需的效果，它将比您的技术快得多。从键盘上玩自动过滤器。如果您可以获得所寻求的效果，请打开宏记录器，使用自动过滤器获取您寻找的选择并关闭宏记录器。调整宏记录器的语句以删除Selection并替换Demo2中的相应语句。

Demo2的秘密是Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)，它将Rng设置为可见行。如果您无法使Auto Filter按照您的意愿工作，并且您决定使用当前技术将不感兴趣的行设置为不可见，请保留此语句以获取剩余的行。但是，我认为宏Demo3使用了更好的技术。

Option Explicit
Sub demo1()

  Dim ColLast As Long
  Dim Rng As Range
  Dim RowLast As Long

  Application.ScreenUpdating = False

  With Worksheets("Source")

    ' This searches up from the bottom of column AB for a cell with a value.
    ' It is the VBA equivalent of placing the cursor at the bottom of column AB
    ' and clicking Ctrl+Up.
    RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row
    Debug.Print "Last row with value in column AB: " & RowLast

    ' This searches for the last cell with a value.
    Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious)

    If Rng Is Nothing Then
      ' Worksheet is empty
    Else
      RowLast = Rng.Row
      ColLast = Rng.Column
      Debug.Print "Last cell with value is: (" & RowLast & ", " & ColLast & _
                  ") = " & Replace(Rng.Address, "$", "")
    End If

  End With

End Sub
Sub Demo2()

  Dim Rng As Range
  Dim SearchDate As String

  SearchDate = "14-May-14"

  Application.ScreenUpdating = False

  With Sheets("Source")
    .Cells.AutoFilter
    .Cells.AutoFilter Field:=28, Criteria1:=SearchDate
    Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
  End With

  ' Rng.Address has a maximum length of a little under 256 characters.
  ' Rng holds the addresses of all the visible rows but you cannot display
  ' all those addresses in an easy manner.  However, this is only to give
  ' you an idea of what is in Rng; the Copy statement below uses the full
  ' set of addresses.
  Debug.Print "Visible rows: " & Rng.Address

  Rng.Copy Worksheets("Dest").Range("A1")

End Sub
Sub Demo3()

  Dim RngToBeCopied As Range
  Dim RowCrnt As Long
  Dim RowLast As Long
  Dim SearchDate As Long

  ' Excel holds dates as integers and times as fractions.
  SearchDate = CLng(DateValue("20 May 2014"))

  With Worksheets("Source")

    RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row

    ' Include header row in range to be copied
    Set RngToBeCopied = .Rows(1)

    For RowCrnt = 2 To RowLast
      If .Cells(RowCrnt, "AB").Value = SearchDate Then
        Set RngToBeCopied = Union(RngToBeCopied, .Rows(RowCrnt))
      End If
    Next

  End With

  Debug.Print RngToBeCopied.Address
  RngToBeCopied.Copy Worksheets("Dest").Range("A1")

End Sub

如何仅将包含数据的行复制到另一个工作簿中的另一个工作表？

1 个答案: