如果在一个范围内找到单个单元格值，则删除整个行

问题描述

我正在处理每个数据，每个数据站记录31天的数据，我需要一个VBA代码来删除闰年。我有一个记录数据的日期列表和一个不是我想删除的闰年的列表。要删除额外的30天和31天，我使用以下基本代码：

Dim lastrow，i As Long

lastrow = ActiveSheet.Cells（65536，1）.End（xlUp）.Row

  For i = 1 To lastrow 
'删除二月份的第31天
如果ActiveSheet.Range（D& i ）= 2 And ActiveSheet.Range（E& i）= 31 Then 
 Rows（i）.Select 
 Selection.Delete shift：= xlUp 
 End If 
 Next i 
  

很简单，工作很好，所以我希望能够做一些类似的事情，我发现数据中不存在的日期（即02/29 / non-leapyear），并删除行，但事实证明是非常难以匹配范围内的值。我正在考虑这样的一些事情：

Dim lastrow，i As Long，leapyear as Workbook / p>

设置leapyear =工作簿（LeapYears.xlsx）

lastrow = ActiveSheet.Cells（65536，1）.End（xlUp）.Row

 对于i = 1显然，这是我遇到问题，试图将单元格匹配到一个范围
如果ActiveSheet.Range（D& i） = leapyear.Sheets（1）range（C2：C90）然后
 Rows（i）.Select 
 Selection.Delete shift：= xlUp 
 End If 
 Next i 
  

非常感谢任何帮助或其他方法来处理这个问题！

解决方案

从

  Sub Sample（）
 
 Dim StartingScreenUpdateValue As乙oolean 
 Dim StartingEventsValue As Boolean 
 Dim StartingCalculations As XlCalculation 
 
应用程序
 StartingScreenUpdateValue = .ScreenUpdating 
 StartingEventsValue = .EnableEvents 
 StartingCalculations =。计算
 .ScreenUpdating = False 
 .EnableEvents = False 
 .Calculation = xlCalculationManual 
 End with 
 
 
 Dim varTestValues As Variant 
 
 varTestValues =工作簿（LeapYears.xlsx）。表（1）.Range（C2：C90）
 
行（1）.Insert 
 [A1] .FormulaR1C1 =TempHeader1
 [A1] .AutoFill目的地：=范围（A1：H1），类型：= xlFillDefault 
 
范围（D1）AutoFilter字段： 4，Criteria1：= Application.Transpose（varTestValues），运算符：= xlFilterValues 
 
范围（D2，Range（D& Rows.Count）.End（xlUp））_ 
 .SpecialCells（xlCellTypeVisible）.EntireRow.Delete 
 
 ActiveSheet.AutoFilterMode = False 
行（1）.Delete 
 
 
应用程序
 .ScreenUpdating = StartingScreenUpdateValue 
 .EnableEvents = StartingEventsValue 
 .Calculation = StartingCalculations 
结束
 
结束Sub 
  

注意： 您的数据有标题，如果没有请指导。

记住 始终运行任何代码数据，而不是您的实际数据，直到您确信它正在工作100％。

I am working with daily data that recorded 31 days of data per multiple stations and I need a VBA code to remove leap year days. I have a list of dates of data recorded and a list of years that are not leap years that I want to delete. To delete the extra 30 and 31 days, I used the basic following code:

Dim lastrow, i As Long

lastrow = ActiveSheet.Cells(65536, 1).End(xlUp).Row

For i = 1 To lastrow
    'delete 31st days for February
    If ActiveSheet.Range("D" & i) = 2 And ActiveSheet.Range("E" & i) = 31 Then
        Rows(i).Select
        Selection.Delete shift:=xlUp
    End If
Next i

Pretty simple and works nicely so I was hoping to be able to do something similar where I find the non-existent date (ie. 02/29/non-leapyear) within the data and delete the row but it has turned out to be extremely difficult to match a value within a range. I was thinking along the lines of something like this:

Dim lastrow, i As Long, leapyear as Workbook

Set leapyear = Workbooks("LeapYears.xlsx")

lastrow = ActiveSheet.Cells(65536, 1).End(xlUp).Row

For i = 1 To lastrow
    'obviously this is where I have the problem trying to match a cell to a range
    If ActiveSheet.Range("D" & i) = leapyear.Sheets(1)range("C2:C90") Then
        Rows(i).Select
        Selection.Delete shift:=xlUp
    End If
Next i

Any help or another way to handle this is greatly appreciated!

解决方案

Modified version of my answer from This Question

Sub Sample()

Dim StartingScreenUpdateValue As Boolean
Dim StartingEventsValue As Boolean
Dim StartingCalculations As XlCalculation

With Application
    StartingScreenUpdateValue = .ScreenUpdating
    StartingEventsValue = .EnableEvents
    StartingCalculations = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Dim varTestValues As Variant

varTestValues = Workbooks("LeapYears.xlsx").Sheets(1).Range("C2:C90")

Rows(1).Insert
[A1].FormulaR1C1 = "TempHeader1"
[A1].AutoFill Destination:=Range("A1:H1"), Type:=xlFillDefault

Range("D1").AutoFilter Field:=4, Criteria1:=Application.Transpose(varTestValues), Operator:=xlFilterValues

Range("D2", Range("D" & Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete

ActiveSheet.AutoFilterMode = False
Rows(1).Delete


With Application
    .ScreenUpdating = StartingScreenUpdateValue
    .EnableEvents = StartingEventsValue
    .Calculation = StartingCalculations
End With

End Sub

NOTE: This code runs assuming your data has headers if it does not please advise.

REMEMBER Always run any code on a copy of your data and not your actual data until you are confident that it is working 100%.

这篇关于如果在一个范围内找到单个单元格值，则删除整个行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！