主页 / coding / 问题 / 79556977
Accepted
Shiela
Asked: 2025-04-05 20:49:04 +0800 CST

如何使用来自 Sheet2 的值的组合框对 Sheet1 的数据进行排序？

  • 772

我这里有 2 张表。一张表用于存放主要数据。另一张表用于存放“名队”条目。

Sheet1（故意留空——如果有空白也可以查看结果）

一个 乙 碳
姓名 添加日期 修改日期
安娜 2025 年 3 月 11 日 2025 年 3 月 18 日
小牛 2025 年 3 月 11 日 2025 年 3 月 12 日
丽莎 2025 年 3 月 14 日 2025 年 3 月 13 日
罗恩 2025 年 3 月 11 日 2025 年 3 月 14 日
玛丽 2025 年 3 月 12 日 2025 年 3 月 15 日
库尔特 2025 年 3 月 13 日 2025 年 3 月 17 日
2025 年 3 月 15 日
凯文 2025 年 3 月 16 日

工作表2

一个 乙
团队 姓名
露西 安娜
露西 小牛
彼得 丽莎
彼得 罗恩
诺里 玛丽
诺里 库尔特
卡尔 莫娜
卡尔 凯文

列表框：

错误的团队

我想选择来自 Sheet2 的团队。下面有一段代码，但会出现“类型不匹配”的错误。

在 ComboBox 更改期间调用 showList：

Sub showList()
    Dim ws As Worksheet, colList As Collection
    Dim arrData, arrList, i As Long, j As Long
    Dim targetTeam As Variant
    ' *** 
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
    Dim arr: arr = ws2.Range("B1").CurrentRegion.Value
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr)
        dict(arr(i, 2)) = Empty
    Next
   ' ***

    Set colList = New Collection
    Set ws = Worksheets("Sheet1")
    arrData = ws.Range("A1:E" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
    For i = 2 To UBound(arrData)
            targetTeam = Application.VLookup((arrData(i, 2)), ws2.Range("B1").CurrentRegion.Value, -1, False)
                If dict.exists(arrData(i, 1)) And cmbTeam = targetTeam Then
                    colList.Add i, CStr(i)
                End If

    Next
    ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))
    For j = 1 To 5
        arrList(1, j) = arrData(1, j) ' header
        arrList(1, 4) = "Date Added Duration"
        arrList(1, 5) = "Date Modified Duration"
        For i = 1 To colList.count
                arrList(i + 1, j) = arrData(colList(i), j)
                    Dim dateA As Variant
                    Dim dateB As Variant
                    Dim dateC As Variant
                    Dim difference1 As Long
                    Dim difference2 As Long
                
                ' Assign values to the dates
                dateA = arrList(i + 1, 2)
                dateB = arrList(i + 1, 3)
                dateC = Format(Now, "m/d/yyyy")
                
                ' Calculate the difference in days
                difference1 = DateDiff("d", dateA, dateC) 'date today minus date added
                
                If Not dateA = "" Then
                    If difference1 > 1 Then
                    arrList(i + 1, 4) = difference1 & " days"
                    Else
                    arrList(i + 1, 4) = difference1 & " day"
                    End If
                Else
                    arrList(i + 1, 4) = "Missing"
                End If
                
                difference2 = DateDiff("d", dateB, dateC) 'date today minus date modified
                
                If Not dateB = "" Then
                    If difference2 > 1 Then
                    arrList(i + 1, 5) = difference2 & " days"
                    Else
                    arrList(i + 1, 5) = difference2 & " day"
                    End If
                Else
                    arrList(i + 1, 5) = "Missing"
                End If
        Next
    Next
    With Me.ListBox1
        .Clear
        .ColumnCount = UBound(arrData, 2)
        .list = arrList
    End With
End Sub

类型不匹配错误

错误代码

期望：

期望结果

excel

1 个回答

  1. Best Answer

    过滤词典条目

    Sub showList()

    Dim ws As Worksheet, ws2 As Worksheet, colList As Collection
    Dim arr, arrData, arrList, i As Long, j As Long, n As Long
    Dim dt As Date, dif As Long, targetTeam As Variant

    targetTeam = "Nory" ' replace "Nory" with cmbTeam
    Set ws2 = Sheets("Sheet2")
    arr = ws2.Range("B1").CurrentRegion.Value
    
    ' names for team
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr)
        If arr(i, 1) = targetTeam Then
            dict(arr(i, 2)) = i
        End If
    Next
   
    ' data for team
    Set ws = Sheets("Sheet1")
    arrData = ws.Range("A1:E" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    Set colList = New Collection
    For i = 2 To UBound(arrData)
        If dict.exists(arrData(i, 1)) Then
            colList.Add i, CStr(i)
        End If
    Next
    
    ReDim arrList(1 To colList.Count + 1, 1 To 5)
    arrList(1, 4) = "Date Added Duration"
    arrList(1, 5) = "Date Modified Duration"
    
    For j = 1 To 3
        arrList(1, j) = arrData(1, j) ' header
       
        For n = 1 To colList.Count
            i = n + 1
            arrList(i, j) = arrData(colList(n), j)
            
            ' calc add and mod diffs
            If j > 1 Then
                If arrList(i, j) = "" Then
                    arrList(i, j + 2) = "Missing"
                Else
                    dt = arrList(i, j)
                    dif = DateDiff("d", dt, Now) 'date today minus date add/mod
                    arrList(i, j + 2) = dif & IIf(dif > 1, " days", " day")
                End If
            End If
        Next
    Next
    
    With Me.ListBox1
        .Clear
        .ColumnCount = UBound(arrList, 2)
        .List = arrList
    End With
End Sub
    • 1

相关问题