如何根据值省略列并使用 VBA 将结果粘贴到新工作表中？答案

【问题标题】：How can I omit columns based on a value and paste the results in a new sheet with VBA?如何根据值省略列并使用 VBA 将结果粘贴到新工作表中？
【发布时间】：2022-07-22 03:35:43
【问题描述】：

我的 VBA 生锈了，我正在努力构建这个宏

我希望创建一个按钮宏来省略标题值等于- 的几列，并将结果粘贴到新工作表中。

我担心的是我不知道如何做到这一点，以便宏不只是省略列并在省略的列位置留下空白列。

我见过将列设置为数组的方法。但是，此文档有大约 100 个活动列，我不确定如何使用这么多列有效地管理一个数组。

提前致谢！
卡住了

【问题讨论】：

循环列？
您使用的是什么版本的 Excel？
Excel 版本 2201

标签： excel vba

【解决方案1】：

您好，Stuck，我根据您的要求编写了此代码，因为我可能在不久的将来可能需要它，或者其他人会需要它。

我用 600 列 测试了代码，每列 10 行 并用了大约 1.30 秒 完成，其中 300 列有 header = " -" 和其他 300 列是随机标题名称。

这里没有技巧，只是使用 Range.SpecialCells(xlCellTypeVisible) - 仅查找符合以下条件的单元格没有隐藏-应该做的工作，其余的只是正常的步骤。

告诉我它是否对您有用，因为它可能需要一些修复来匹配您的图纸模型。赞！

   Sub test()
      Dim Rng_ As Range
      Dim Sheet_ As Worksheet
      
      
        'Disable animations while running
        Application.ScreenUpdating = False
        
        
      
        'Get CurrentRegion (Cells(1,1) is the same as Range("A1"))
        Set Rng_ = ActiveSheet.Cells(1, 1).CurrentRegion
        Rng_.Select
        
        
        'Get Headers row (Change it to the row where your headers are)
        Set Headers_ = Rng_.Rows(1)
        Headers_.Select
        
        
        'Hide headers = "-"
        For Each Header_ In Headers_.columns
            If Header_ Like "-" Then
                Set Column_ = Rng_.columns(Header_.Column)
                If Not (Column_.Hidden) Then Column_.Hidden = True
            End If
        Next
    
    
        'Get SpecialCells = xlCellTypeConstants
        On Error Resume Next
        Set Content_ = Nothing
        Set Content_ = Rng_.SpecialCells(xlCellTypeVisible)
        Content_.Select
        On Error GoTo 0
        
        
        'Create a new sheet
        If Not Content_ Is Nothing Then
            Set Workbook_ = Workbooks(Rng_.Parent.Parent.Name)
            Set Sheet_ = Workbook_.Sheets(Rng_.Parent.Name)
            Set Worksheet2_ = Workbook_.Worksheets.Add(after:=Sheet_)
            Worksheet2_.Name = Sheet_.Name & " | Filtered"
            Worksheet2_.Tab.Color = rgbCornflowerBlue                   'Add some color (life is colorful)
        
            'Paste the results into new sheet
            Content_.Copy Destination:=Worksheet2_.Cells.Range("A1")
        
        End If
    
    
    End Sub

【讨论】：