Question

我有一张工作簿，每天更新一张（Oz）。另一张表（Schedule）按周水平显示。我确定下周一的日期在“Schedule”中搜索该列，并清除该列右侧“Schedule”上的所有内容（这与clearschedule函数一起使用）。然后我想用'Oz'中的最新数据重建'Schedule' 我在列K上排序'Oz'（这是有效的）。然后我过滤第1周的所有安装（开始大于或等于下周一，少于下周日）。我从'Oz'复制选择（H2：N？），在'Schedule'上找到匹配的startWeek列，然后将选定的'Oz'列粘贴到'Schedule'......第1周绘制（这是有效的）现在我试图循环这4次（7到28步7）来选择并从'Oz'复制到'Schedule'中的下一个4周。这就是问题所在.......它一直将原来的第1周数据粘贴到“附表”

的下一周

有谁能告诉我为什么代码不会在下周过滤，复制和粘贴？

Sub tracker2()
  clearSchedule
  Dim fundingDate As Range
  Dim SourceLastRow As Long
  Dim sourceBook As Workbook
  Dim sourceSheet As Worksheet
  Dim copyRange As Range
  Dim sched As Worksheet
  Dim startWeek As Date
  Dim endWeek As Date
  Dim f As Range
  Dim Col_letter
  Dim x As Integer
  Set sourceBook = ThisWorkbook
  Set sourceSheet = sourceBook.Worksheets("Oz")
    'Determine last row of source from Oz
   With sourceSheet
       SourceLastRow = .Cells(.Rows.Count, "K").End(xlUp).row
   End With
   Columns("A:AM").Sort key1:=Range("K:K"), order1:=xlAscending, Header:=xlYes
   Set sched = ThisWorkbook.Sheets("Schedule")

   Set fundingDate = sourceSheet.Range("K1:K" & SourceLastRow)
   'need to loop 4 times
    For x = 7 To 28 Step 7
        startWeek = Date - (Weekday(Date, vbMonday) - 1) + x
        endWeek = Date + (7 - Weekday(Date, vbMonday)) + x
        Set f = sched.Cells.Find(startWeek)
        Col_letter = Split(Cells(1, f.Column).Address(True, False), "$")(0)
        'sets oz to sort on inst start
        With fundingDate
          .AutoFilter Field:=1, Criteria1:= _
            ">=" & startWeek, Operator:=xlAnd, Criteria2:="<" & endWeek
           Set copyRange = sourceSheet.Range("H2:N" & SourceLastRow)
           copyRange.SpecialCells(xlCellTypeVisible).Copy sched.Range(Col_letter & "17")
       End With
    Application.CutCopyMode = False
    Next x
  'close 4 times loop
  Cells.AutoFilter
End Sub

Answer 1

也许在循环中重新应用之前尝试删除过滤器？未测试的：

Sub tracker2()
    clearSchedule
    Dim fundingDate As Range
    Dim SourceLastRow As Long
    Dim sourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim copyRange As Range
    Dim sched As Worksheet
    Dim startWeek As Date
    Dim endWeek As Date
    Dim f As Range
    Dim x As Integer

    Set sourceBook = ThisWorkbook
    Set sourceSheet = sourceBook.Worksheets("Oz")
    'Determine last row of source from Oz
    With sourceSheet
        SourceLastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
    End With

    sourceSheet.Columns("A:AM").Sort key1:=Range("K:K"), _
                     order1:=xlAscending, Header:=xlYes

    Set sched = ThisWorkbook.Sheets("Schedule")

    Set fundingDate = sourceSheet.Range("K1:K" & SourceLastRow)
    Set copyRange = sourceSheet.Range("H2:N" & SourceLastRow)

    'need to loop 4 times
     For x = 7 To 28 Step 7

         startWeek = Date - (Weekday(Date, vbMonday) - 1) + x
         endWeek = Date + (7 - Weekday(Date, vbMonday)) + x

         'sets oz to sort on inst start
         With fundingDate
            .Parent.Cells.AutoFilter '<<<remove any previous filter
            .AutoFilter Field:=1, Criteria1:=">=" & startWeek, _
                        Operator:=xlAnd, Criteria2:="<" & endWeek
         End With

         Set f = sched.Cells.Find(startWeek)
         copyRange.SpecialCells(xlCellTypeVisible).Copy _
                               sched.Cells(17, f.Column)

     Application.CutCopyMode = False
     Next x 'close 4 times loop

    Cells.AutoFilter

End Sub

在不同页面上进行多项选择和复制

1 个答案: