Question

该函数应循环遍历过滤范围，并将特定日期附加到第一个＆＃34; i＆＃34;线然后移动到下一个日期并重复。

它会将所有内容追加到标题中，而不是每次向下移动一行。

这不是错误的，只是没有按预期行事。我在哪里错了？

 Sub Function()

Dim wsExport As Worksheet
Set wsExport = Workbooks("Export Workbook").Worksheets("Export")

Dim uiStartDate As Variant 'I'm using the prefix ui to be User Input
Dim uiEndDate As Variant
Dim uiCount As Variant
Dim cStartDate As Long 'Converted to date
Dim cEndDate As Long
Dim cCount As Long
Dim iDate As Long 'Counter for the date
Dim i As Long 'Counter for the number of items per day.
Dim j As Long 'Counter for Rows
Dim lRow As Long

lRow = Cells.Find(What:="*", LookAt:=xlPart, _
                LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False).Row



'Prompt the user for the start date and end date
'uiStartDate = InputBox("Input the first day of week in the format of 01/20/2018", "Start Date User Input")
'uiEndDate = InputBox("Input the last day of week in the format of 01/25/2018", "End Date User Input")
'uiCount = InputBox("Input the number of items per day.", "Installtion Quantity User Input")
uiStartDate = "1/20/2018" 'This is to speed during testing. Will use the above for actual code
uiEndDate = "1/25/2018"
uiCount = "2"


'Convert to their proper data types. (User inputs have to be variants to begin with)
cStartDate = CDate(uiStartDate)
cEndDate = CDate(uiEndDate)
cCount = CLng(uiCount)

With wsExport.Range("A:AP")
    .AutoFilter Field:=19, Criteria1:=">=" & uiStartDate
End With

iDate = cStartDate
j = 2
i = 1

Do While j <= lRow
DoEvents
If Not wsExport.Rows(j).Hidden Then
    wsExport.Range("S" & j).Value = wsExport.Range("S" & j).Value & "-" & iDate
    i = i + 1
    End If

    If i > cCount Then
        i = 1
        iDate = iDate + 1
    End If

    If iDate > cEndDate Then
        j = lRow + 1
    End If
j = j + 1
Loop



End Sub

Answer 1

xlCellTypeVisible在处理像这样的单元格的偏移时不能做你想要的。只需使用IF：

For i = 1 To cCount
  currentRow = currentCell.Offset(1, 0).Row
  Set currentCell = wsExport.Range("S" & currentRow)
  if currentcell.rowheight > 0 then currentCell.Value = currentCell.Value & "- " & iDate

Next i

Answer 2

这是一个使用不同方法循环遍历表格的简化示例：

编辑：更新为每两行增加日期的实际过程......

Sub Tester()

    Dim sht As Worksheet, rngTable As Range, rw As Range, r As Long
    Dim sDate, eDate, dt, i As Long

    Set sht = ActiveSheet
    Set rngTable = sht.Range("A1").CurrentRegion

    rngTable.AutoFilter                           'clear any previous filter
    rngTable.AutoFilter field:=4, Criteria1:=">3" 'filter to required rows only

    'some dates...
    sDate = Date
    eDate = Date + 3

    dt = sDate 'set date to add
    i = 0

    For r = 2 To rngTable.Rows.Count
        Set rw = rngTable.Rows(r)
        'is the row visible?
        If Not rw.Hidden Then
            With rw.Cells(2)
                .Value = .Value & " - " & Format(dt, "dd/mm/yyyy")
            End With
            i = i + 1
            If i Mod 2 = 0 Then dt = dt + 1  '<< next date every 2 visible rows
            If dt > eDate Then Exit For      '<< exit if run out of dates
        End If
    Next r

End Sub

循环可见范围问题

2 个答案: