Excel-VBA将公式转换为应用了自动筛选的工作表上的值

9o685dep  于 2023-01-31  发布在  其他
关注(0)|答案(1)|浏览(125)

当工作表应用了自动筛选时,是否有任何方法可以有效地将工作表上的所有公式转换为值?
我已经探索了保存自动过滤参数,取消过滤以粘贴值,然后使用保存的参数重新过滤..发现一些代码可以工作,但风险太大(显然只适用于基本的过滤逻辑)
如果可能的话,我希望避免“针对每个单元格”,因为工作表上的一些报告可能相当长

tcomlyy6

tcomlyy61#

将筛选工作表中的公式转换为值

Option Explicit

Sub FilteredToValues()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1") ' adjust!
    Dim srg As Range: Set srg = sws.UsedRange
    
    If Not sws.FilterMode Then ' the worksheet is not in filter mode
        srg.Value = srg.Value ' or whatever
        Exit Sub
    End If
    
    ' When the worksheet is in filter mode, that means that at least
    ' one row is hidden. It also means that at least one row, the header row,
    ' is visible. Thus no error handling is necessary.
    
    Dim arg As Range
    
    ' Convert the visible range.
    
    ' Reference the visible rows.
    Dim vrg As Range: Set vrg = srg.SpecialCells(xlCellTypeVisible)
    
    ' Convert by looping through the areas of the visible range.
    For Each arg In vrg.Areas
        arg.Value = arg.Value
    Next arg
    
    ' Convert the hidden range.
    
    ' Reference the visible cells in the first column.
    Dim vcrg As Range: Set vcrg = Intersect(srg.Columns(1), vrg)
    
    Dim urg As Range, cel As Range
    
    ' Combine the hidden cells of the first column into a range.
    For Each cel In srg.Columns(1).Cells
        If Intersect(cel, vcrg) Is Nothing Then
            If urg Is Nothing Then Set urg = cel Else Set urg = Union(urg, cel)
        End If
    Next cel
    
    ' Reference the hidden rows.
    Dim hrg As Range: Set hrg = Intersect(urg.EntireRow, srg)
    
    ' Convert by looping through the areas of the hidden range.
    For Each arg In hrg.Areas
        arg.Value = arg.Value
    Next arg
    
    MsgBox "Formulas converted to values.", vbInformation
 
End Sub

相关问题