好吧所以我可能有点过头了,昨天我开始搞乱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
基本上我想删除带有标题的行,对我已经拥有的内容或者如何更有效地设置变量的任何建议都会很棒。
答案 0 :(得分:0)
HeaderRowRange
是ListObject
的组成部分 它无法删除。因此,如果需要删除标题数据 那么你必须先将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 嘿,谢谢你花时间试图回答我措辞不好的问题,这是我的问题的解决方案,我在标题行中引用了一个单词,并从那里删除了行