遍歷列過濾時可見的資料

以下代碼是我經過大量研究和努力作業后撰寫的，但是我現在發現這沒有用，因為我在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 列就是我遇到問題的地方。

uj5u.com熱心網友回復：

回圈過濾資料行

• 未測驗。

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

標籤：擅长 vba

上一篇：在Excel中將數字轉換為非數字

下一篇：基于兩列條件插入新行的vba代碼