excel 将每个工作簿中的值编译到主工作簿

68bkxrlz  于 2023-08-08  发布在  其他
关注(0)|答案(1)|浏览(78)

每个日期我都有多个工作簿。Workbook_20230505,格式如下:
| 时间|工作人员| Staff |
| --|--| ------------ |
| 上午9:00:35|系统| SYSTEM |
| 5:32:05 AM|系统| SYSTEM |
| 时间:4:15:35| ALEX| ALEX |
| 10:00 - 12:00|克莱尔| CLARE |
| 时间:2018 - 02 - 18|约翰| JOHN |
| 3:23:10 AM|桑迪| SANDY |
| 时间:2019 - 04 - 09|曼达| MANDA |
| 时间:2019年10月15日上午7时15分23秒|无效| VOID |
| 时间:2019 - 06 - 15| ALEX| ALEX |
| 3:46:15 AM| KEN| KEN |
| 2017年12月18日上午7:08:23| KEAT| KEAT |
我能够使用公式=MAXIFS(B3:B13, C3:C13, "<>SYSTEM", C3:C13, "<>VOID")获得给定标准的最新时间
我如何编译的结果在一个主文件如下?
| 最新时间| Latest Time |
| --| ------------ |
| ||
| ||
| ||
我尝试使用下面的,但似乎很难使其动态:

ActiveSheet.Range("B2").Select
ActiveCell.FormulaR1C1 = _
    "=MAXIFS([Workbook_20230505.xlsx]Sheet1!R3C2:R13C2,[Workbook_20230505.xlsx]Sheet1!R3C4:R13C4,""<>SYSTEM"",[Workbook_20230505.xlsx]Sheet1!R3C4:R13C4,""<>VOID"")"

字符串
我也在尝试下面的东西,但是,我得到了错误:

strPath = "C:\Users\...\Workbook_20230505.xlsx"
Set wb = Workbooks.Open(strPath)
Set ws = wb.Worksheets("Sheet1")
Set sheet = ActiveSheet
Set rng1 = ws.Range("B3:B13")
Set rng2 = ws.Range("C3:C13")

sheet.Range("B2").Select
'ActiveCell.FormulaR1C1 = _
    '"=MAXIFS(rng1, rng2, "<>SYStem", rng2, "<>VOID")"


最后,我想使用for循环来获得每个日期的结果。
感谢帮助!

0vvn1miw

0vvn1miw1#

不使用WorksheetFunction.MaxIfs,您可以使用For循环获得所需的结果。

Sub GetMax()
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MaxValue As Date
    Dim DatePart As String
    Dim LastRow As Long
    Dim arr
    Application.ScreenUpdating = False
    ' Update your folder name
    FolderPath = "D:\Temp\"
    ' Clean activesheet and set format
    With ActiveSheet
        .UsedRange.Clear
        .[A1:B1].Value = Array("Date", "LatestTime")
        .Columns(1).NumberFormat = "mm/dd/yyyy"
        .Columns(2).NumberFormat = "h:mm:ss AM/PM"
    End With
    ' Retrieve files with "Workbook_*.xlsx"
    FileName = Dir(FolderPath & "Workbook_*.xlsx")
    Do While FileName <> ""
        DatePart = Split(FileName, "_")(1)
        Set wb = Workbooks.Open(FolderPath & FileName)
        Set ws = wb.Sheets(1)
        ' Get max value of column B
        arr = ws.UsedRange.Value
        MaxValue = 0
        If UBound(arr, 2) >= 3 Then
        For i = 2 To UBound(arr)
            If InStr("SYSTEM|VOID", UCase(arr(i, 3))) = 0 Then
                If MaxValue < arr(i, 2) Then MaxValue = arr(i, 2)
            End If
        Next
        End If
        wb.Close SaveChanges:=False
        With ThisWorkbook.Sheets(1)
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Or .Cells(LastRow, 1) <> "" Then LastRow = LastRow + 1
            .Cells(LastRow, "A").Value = DateSerial(CInt(Mid(DatePart, 1, 4)), CInt(Mid(DatePart, 5, 2)), CInt(Mid(DatePart, 7, 2)))
            .Cells(LastRow, "B").Value = MaxValue
        End With
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

字符串


的数据

相关问题