gpt4 book ai didi

excel - 遍历列过滤时可见的数据

转载 作者:行者123 更新时间:2023-12-04 22:15:06 26 4
gpt4 key购买 nike

以下代码是我经过大量研究和辛勤工作后编写的,但是我现在发现这没有用,因为我在 worksheetsheet 中有多个过滤器.我不想遍历工作表中的所有数据,我只想遍历过滤时可见的数据。但是,使用我的代码,它会遍历所有行。一次我最多过滤 5 列。
dt = CDate(Sheets("Sheet5").Range("P2").Value)我已经给了 P2,但是当我过滤它时它可能不可见,我不想检查这个单元格中的数据。

Sub FindDuration()

Dim totalDuration As Single
Dim dt As Date
Dim nextDt As Date
Dim maxDt As Date
Dim DateDiff
Dim lr As Long
Dim lrw As Long
Dim lr1 As Long
Dim i As Long

totalDuration = 0
dt = 0
lr1 = ThisWorkbook.Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp).Row

dt = CDate(Sheets("Sheet5").Range("P2").Value)
maxDt = dt + 1

For i = 2 To lr1

DateDiff = maxDt - dt

If DateDiff <= 1 And nextDt <= maxDt Then
totalDuration = totalDuration + Sheets("Sheet5").Range("G" & i).Value
nextDt = CDate(Sheets("Sheet5").Range("P" & i + 1).Value)
Else
lrw = ThisWorkbook.Sheets("Chart").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Chart").Range("A" & lrw + 1).Value = totalDuration
totalDuration = Sheets("Sheet5").Range("G" & i).Value
dt = CDate(Sheets("Sheet5").Range("P" & i).Value)
maxDt = dt + 1

End If

Next i
lrw = ThisWorkbook.Sheets("Chart").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Chart").Range("A" & lrw + 1).Value = totalDuration

End Sub
我知道这段代码并不完美,因为我不是 VBA 专家。
编辑:
您在下图中看到的只是示例数据。 J 和 K 列中的值(在我们的代码 G 和 P 中)是我们所拥有的 L、N、O 是我们想要的。我们几乎已经用我们的代码完成了“要添加的总持续时间”,而 N 和 O 列是我遇到问题的地方。
enter image description here

最佳答案

遍历过滤数据的行

  • 未测试。

  • Option Explicit

    Sub FindDuration()

    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet5")
    Dim slRow As Long: slRow = sws.Range("A" & sws.Rows.Count).End(xlUp).Row
    Dim slCol As Long
    slCol = sws.Cells(1, sws.Columns.Count).End(xlToLeft).Column
    Dim srg As Range: Set srg = sws.Range("A2", sws.Cells(slRow, slCol))
    Dim svrg As Range: Set svrg = srg.SpecialCells(xlCellTypeVisible)

    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Chart")
    Dim dCell As Range
    Set dCell = dws.Range("A" & dws.Rows.Count).End(xlUp).Offset(1)

    Dim sarg As Range
    Dim srrg As Range
    Dim dt As Date
    Dim dtNext As Date
    Dim dtMax As Date
    Dim dtDiff As Double ' possibly 'As Long' ???
    Dim totalDuration As Double
    Dim IsNotFirst As Boolean
    Dim DoGetNextDate As Boolean

    For Each sarg In svrg.Areas

    For Each srrg In sarg.Rows

    If Not IsNotFirst Then
    dt = CDate(srrg.Columns("P").Value)
    dtMax = dt + 1
    IsNotFirst = True
    End If

    dtDiff = dtMax - dt

    If DoGetNextDate Then
    dtNext = CDate(srrg.Columns("P").Value)
    End If

    If dtDiff <= 1 And dtNext <= dtMax Then
    totalDuration = totalDuration + srrg.Columns("G").Value
    DoGetNextDate = True
    Else
    dCell.Value = totalDuration
    Set dCell = dCell.Offset(1)
    totalDuration = srrg.Columns("G").Value
    dt = CDate(srrg.Columns("P").Value)
    dtMax = dt + 1
    DoGetNextDate = False
    End If

    Next srrg

    Next sarg

    'dcell.Value = totalDuration ' not quite sure???

    End Sub

    关于excel - 遍历列过滤时可见的数据,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/70371656/

    26 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com