VBA-通過使用變體構建來確定時間和日期

Question

我得到了解決上一個問題的幫助。 我想類似地解決這個問題。

因此，情況類似於Countifs函數，因為我希望它計算范圍是否等於某個建築物，以及偏移的日期和時間是否等於某個日期。 例如，如果"C1" = "Irving Building"的單元格，並且如果"K1" = "Monday"的值，那么我希望它顯示在"S1" 。 更具體地說，如果"C1" = "Irving Building"令人"C1" = "Irving Building"那么我希望它在Column K計入與其對應的任何日期和時間。

Private Sub TimeAndDate()

Dim n           As Double
Dim rep         As Worksheet
Dim ws          As Worksheet
Dim LastRow     As Double

Set rep = Worksheets("Report")

rep.Columns("K:L").ClearContents

For n = 1 To ThisWorkbook.Sheets.Count

    Set ws = Worksheets(n)

    If IsNumeric(ws.Name) Then
        LastRow = rep.Range("K1", rep.Range("K1").End(xlDown)).Rows.Count
        LastRow = LastRow + 1

        If rep.Range("K1") = "" Then
            ws.Range("C2", ws.Range("C2").End(xlDown)).Copy _
            Destination:=rep.Range("K1")
            ws.Range("C2", ws.Range("C2").End(xlDown)).Copy _
            Destination:=rep.Range("L1")
        Else:
            ws.Range("C2", ws.Range("C2").End(xlDown)).Copy _
            Destination:=rep.Range("K" & LastRow)
            ws.Range("C2", ws.Range("C2").End(xlDown)).Copy _
            Destination:=rep.Range("L" & LastRow)
        End If

    End If

Next n

    Dim rDts As Range
    Dim vDts As Variant
    Dim vCnts As Variant
    Dim vAP As Variant    'for the AM PM count
    Dim vDbld As Variant  'for the date by building
    Dim vTbld As Variant  'for thee time by building
    Dim i As Long, J As Long

'read dates into array -- faster processing
With rep
    vDts = .Range(.Cells(1, 11), .Cells(.Rows.Count, 11).End(xlUp))
End With

'Results array
ReDim vCnts(1 To 7, 1 To 2)
    vCnts(1, 1) = "Sunday"
    vCnts(2, 1) = "Monday"
    vCnts(3, 1) = "Tuesday"
    vCnts(4, 1) = "Wednesday"
    vCnts(5, 1) = "Thursday"
    vCnts(6, 1) = "Friday"
    vCnts(7, 1) = "Saturday"

ReDim vAP(1 To 2, 1 To 2)
    vAP(1, 1) = "AM"
    vAP(2, 1) = "PM"

ReDim vDbld(1 To 13, 1 To 2)
    vDbld(1, 1) = "Irving Building"
    vDbld(2, 1) = "Memorial Building"
    vDbld(3, 1) = "West Tower"
    vDbld(4, 1) = "Witting Surgical Center"
    vDbld(5, 1) = "Madison Irving Surgical Center"
    vDbld(6, 1) = "Marley Education Center"
    vDbld(7, 1) = "410 South Crouse"
    vDbld(8, 1) = "Physicians Office Building"
    vDbld(9, 1) = "Crouse Business Center"
    vDbld(10, 1) = "Commonwealth Place"
    vDbld(11, 1) = "Irving - Memorial Connector"
    vDbld(12, 1) = "Crouse Garage"
    vDbld(13, 1) = "CNY Medical Center"

'Do the counts
    For i = 1 To UBound(vDts, 1)

        J = Weekday(vDts(i, 1))
        vCnts(J, 2) = vCnts(J, 2) + 1

        If Hour(vDts(i, 1)) < 12 Then
            vAP(1, 2) = vAP(1, 2) + 1
        Else
            vAP(2, 2) = vAP(2, 2) + 1
        End If


    Next i

'output the results
rep.Range("E1:E14").Copy rep.Range("Q1")
rep.Range("N2:N8").Copy
rep.Range("R1").PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, _
False, True
rep.Range("N11:N12").Copy
rep.Range("Y1").PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, _
False, True

rep.Range("N1") = "DATE"
rep.Range("O1") = "COUNT"
rep.Range("N10") = "TIME"
rep.Range("O10") = "COUNT"
rep.Range("N2:O8").Value = vCnts
rep.Range("N11:O12").Value = vAP

我需要幫助的部分在這里。 這些是我想使用的變體，但是就像我之前說的，我不知道如何在不運行大量countifs語句的情況下執行此countifs 。

    Dim vDbld As Variant  'for the date by building
ReDim vDbld(1 To 13, 1 To 2)
    vDbld(1, 1) = "Irving Building"
    vDbld(2, 1) = "Memorial Building"
    vDbld(3, 1) = "West Tower"
    vDbld(4, 1) = "Witting Surgical Center"
    vDbld(5, 1) = "Madison Irving Surgical Center"
    vDbld(6, 1) = "Marley Education Center"
    vDbld(7, 1) = "410 South Crouse"
    vDbld(8, 1) = "Physicians Office Building"
    vDbld(9, 1) = "Crouse Business Center"
    vDbld(10, 1) = "Commonwealth Place"
    vDbld(11, 1) = "Irving - Memorial Connector"
    vDbld(12, 1) = "Crouse Garage"
    vDbld(13, 1) = "CNY Medical Center"

如果這令人困惑，我深表歉意，我不完全確定該如何措辭，在此先感謝。

這是我想要的示例：

Answer 1

您可以簡單地使用Application.Match來檢查字符串是否在數組中，並且它將返回索引，因為此函數只能處理一維數組，還有另一個函數可以返回數組的一維。 之后，您可以檢查偏移量並對其進行如下處理：

Dim mindex as Variant
mindex = Application.Match(rDts(i, 3), Only1D(vDbld, 1), 0)
If Not IsError(mindex) Then
   'do stuff i.e
   vDbld(mindex, 2) = vDbld(mindex, 2) + 1
End If

Function Only1D(arr As Variant, d As Long)
Dim size As Long: size = UBound(arr, d)
Dim arr2 As Variant
ReDim arr2(1 To size)
For i = 1 To size
    arr2(i) = arr(i, d)
Next
Only1D = arr2
End Function