我明白你遇到的痛点了——内置日期筛选在处理单年度范围时确实不够灵活，而且你的原代码存在语法错误（比如多余的End If）、逻辑偏差（错误使用Match函数，只匹配单个日期而非范围），还没处理输入日期不存在的场景。下面是优化后的VBA代码，完全满足你的需求：

Sub SelectDateRange()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim inputDate As Date, targetDate As Date
    Dim pt As PivotTable, pf As PivotField
    Dim pi As PivotItem
    Dim foundDate As Boolean
    Dim closestDate As Date
    
    ' 初始化工作表和数据透视表对象
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set pt = ws2.PivotTables("MainTable")
    Set pf = pt.PivotFields("Date")
    
    ' 验证输入日期是否有效
    If IsDate(ws1.Range("A10").Value) Then
        inputDate = ws1.Range("A10").Value
    Else
        MsgBox "请在Sheet1的A10单元格输入有效的日期！", vbExclamation
        Exit Sub
    End If
    
    ' 清除原有筛选
    pf.ClearAllFilters
    
    ' 初始化最近日期为当年1月1日
    closestDate = DateSerial(Year(inputDate), 1, 1)
    foundDate = False
    
    ' 遍历所有日期透视项，找到最接近输入日期的上一个可用日期
    For Each pi In pf.PivotItems
        If IsDate(pi.Name) Then
            Dim itemDate As Date
            itemDate = CDate(pi.Name)
            
            ' 如果找到完全匹配的日期，直接设置为目标日期
            If itemDate = inputDate Then
                targetDate = itemDate
                foundDate = True
                Exit For
            ' 如果当前日期小于输入日期，且比已记录的最近日期大，更新最近日期
            ElseIf itemDate < inputDate And itemDate > closestDate Then
                closestDate = itemDate
            End If
        End If
    Next pi
    
    ' 如果没找到完全匹配的日期，用最近的上一个可用日期
    If Not foundDate Then
        targetDate = closestDate
        MsgBox "输入的日期不存在，已自动选择最近的上一个可用日期：" & Format(targetDate, "yyyy-mm-dd"), vbInformation
    End If
    
    ' 筛选从当年1月1日到目标日期的所有日期
    For Each pi In pf.PivotItems
        If IsDate(pi.Name) Then
            Dim currentItemDate As Date
            currentItemDate = CDate(pi.Name)
            ' 设置可见性：1月1日到目标日期之间的日期可见，其余隐藏
            pi.Visible = (currentItemDate >= DateSerial(Year(targetDate), 1, 1) And currentItemDate <= targetDate)
        Else
            ' 非日期格式的透视项直接隐藏
            pi.Visible = False
        End If
    Next pi
    
    ' 定位并选中目标日期对应的相邻两个单元格（假设行标签在A列，相邻为B和C列）
    Dim targetCell As Range
    Set targetCell = ws2.Cells.Find(What:=Format(targetDate, "yyyy-mm-dd"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not targetCell Is Nothing Then
        ' 选中当前单元格右侧两个相邻单元格（可根据实际位置调整列偏移）
        targetCell.Offset(0, 1).Resize(1, 2).Select
    Else
        MsgBox "未找到目标日期对应的单元格！", vbExclamation
    End If
End Sub

代码关键点说明： #

• 日期有效性验证：先检查Sheet1的A10是否为有效日期，避免运行错误
• 最近日期匹配逻辑：遍历所有透视项，优先找完全匹配的日期；如果没有，就记录小于输入日期的最大可用日期
• 范围筛选：通过遍历透视项手动设置可见性，绕过内置筛选的单年度限制，实现1月1日到目标日期的范围筛选
• 单元格定位选中：用Find方法定位目标日期的单元格，再选中其右侧相邻的两个单元格（可根据你的实际数据位置调整Offset和Resize参数）

使用注意事项： #

1. 确保数据透视表的"Date"字段的项都是可转换为日期的格式
2. 如果你的行标签不在A列，或者相邻单元格不是B、C列，需要修改最后部分的Offset和Resize参数
3. 可以把这个宏绑定到按钮，或者设置为Sheet1的Change事件（当A10单元格内容变化时自动执行）

内容的提问来源于stack exchange，提问作者Deepak