删除列表中的行

时间:2017-05-18 12:24:30

标签: excel vba excel-vba

好吧所以我可能有点过头了,昨天我开始搞乱VBA Excel,我几乎完成了我的任务。我一直试图通过高级过滤器从几张不同的纸张中提取过滤后的信息并将其列在一张纸上。但是使用我所拥有的代码,它会将过滤后的信息带入并复制我从中提取信息的每个页面的标题。因此,我的列表在这些标题中有一些中断。让我谈到这一点的代码如下:

Sub Filter_Refresh()

' Filter_Refresh Macro

Sheets("55920000").Range("_5592[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range("A1:AF1"), Unique:=False
y = Evaluate("=address(counta(a:a)+1,1,4)")
Sheets("55930000").Range("_5593[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(y), Unique:=False
x = Evaluate("=address(counta(a:a)+1,1,4)")
Sheets("55940000").Range("_5594[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(x), Unique:=False
Z = Evaluate("=address(counta(a:a)+1,1,4)")
Sheets("55950000").Range("_5595[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(Z), Unique:=False

End Sub

基本上我想删除带有标题的行,对我已经拥有的内容或者如何更有效地设置变量的任何建议都会很棒。

2 个答案:

答案 0 :(得分:0)

  

HeaderRowRangeListObject的组成部分   它无法删除。因此,如果需要删除标题数据   那么你必须先将ListObject转换为标准的Excel   使用ListObject的Unlist方法进行范围调整。将此代码添加到   你的程序:

代码正在整个工作表中删除整个标题行..

奖励回答(遍历所有工作表并删除整个标题行。)

Option Explicit

Sub DeleteHeaderRows()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim lob As ListObject
Dim tblHdr As Range
    For Each ws In ThisWorkbook.Worksheets
    MsgBox ws.Name 'Shows you in which page code will run. you can comment out this.
        For Each lob In ws.ListObjects
            'These Fors loop through all of your lists in all of your sheets
            Set tblHdr = ws.ListObjects("" & lob & "").HeaderRowRange
            lob.Unlist 'Convert ListObject to a Range
            tblHdr.EntireRow.Delete  'Delete all row
        Next lob
    Next ws
End Sub

主要答案(仅在一个特定工作表中循环并删除除第一个之外的整个标题行)

Option Explicit
Sub DeleteHeaderRowsTekSayfada()
Dim wb As Workbook
Dim ws As Worksheet
Dim lob As ListObject
Dim tblHdr As Range, PassFrstHdr As Long, begin As Long
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Lists and Criteria")
    begin = 1
        For Each lob In ws.ListObjects
            If begin = 1 Then
            begin = begin + 1   'by the help of this equation we bypass the first header
            Else
            Set tblHdr = ws.ListObjects("" & lob & "").HeaderRowRange
            lob.Unlist 'Convert ListObject to a Range
            tblHdr.EntireRow.Delete  'Delete entire row
            End If
     Next lob
End Sub

答案 1 :(得分:0)

Sub Filter_Refresh()
'
' Filter_Refresh Macro
'
Dim y


Sheets("55920000").Range("_5592[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range("A2:AF2"), Unique:=False

y = Evaluate("=address(counta(a:a)+1,1,4)")

Sheets("55930000").Range("_5593[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(y), Unique:=False

Cells.Find(What:="Propoal #", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False).EntireRow.Delete

x = Evaluate("=address(counta(a:a)+1,1,4)")

Sheets("55940000").Range("_5594[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(x), Unique:=False

Cells.Find(What:="Propoal #", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False).EntireRow.Delete

Z = Evaluate("=address(counta(a:a)+1,1,4)")

Sheets("55950000").Range("_5595[#All]").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Lists and Criteria").Range("D2:D3"), CopyToRange:= _
    Range(Z), Unique:=False

Cells.Find(What:="Propoal #", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False).EntireRow.Delete

End Sub

@Mertinc 嘿,谢谢你花时间试图回答我措辞不好的问题,这是我的问题的解决方案,我在标题行中引用了一个单词,并从那里删除了行