Question

我对以下代码有3个问题：

代码意图：我有一个数据表，4列（F，G，H和I）宽，X行长（X通常在5到400之间）。我在M列中有一个日期列表，通常不超过8个日期。表的H列也包含日期。我想找到两列（H和M）中的日期以及每当它们出现时，转到第一列中的同一行并将其值设置为零，然后将其设置为零（因此，如果匹配是在H100中，然后I100和I101将归零）。

代码问题：编辑1）根据反馈。

1）我使用if公式（= if（H100 = M12,1,0），验证了一个匹配，就像电子表格看到它一样。宏没有找到这个匹配，尽管来自if公式。单元格I100和I101具有非零值，当它们应归零时。

2）代码运行，但需要大约3分钟才能完成3页180行数据。可以做些什么来让它更快更有效地运行？它可能有多达30张数据和400行（极端的例子，但可能，在这种情况下我很高兴让它运行一点）。

3）假设在运行宏之前我的数据表是100行，从第12行开始，在宏之后，第I列具有111行的非零值，并且对于下一个389为零。有没有办法我可以防止它填满零，并将其留空？

我之后在第一列上使用了相关函数，并且0与0的大量一致正在显着扭曲这一点。提前谢谢，

Sub DeleteCells()


Dim ws As Worksheet
Dim cell As Range, search_cell As Range
Dim i As Long
Dim h As Long


Application.ScreenUpdating = False




For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Cover" Then
        For Each cell In ws.Range("H12:H500")



            On Error Resume Next
            h = ws.Range("G" & Rows.Count).End(xlUp).Row
             i = ws.Range("L" & Rows.Count).End(xlUp).Row
            Set search_cell = ws.Range("M12:M" & h).Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole)
            On Error GoTo 0
            If Not search_cell Is Nothing Then
                ws.Range("I" & cell.Row).Value = 0
                ws.Range("I" & cell.Row + 1).Value = 0
                Set search_cell = Nothing
            End If
        Next cell
    End If
Next ws





Application.ScreenUpdating = True




Set ws = Nothing: Set cell = Nothing: Set search_cell = Nothing




End Sub

Answer 1

编辑：TESTED CODE，适用于从第12行开始的H / M列中的0行1行数据？

编辑：更新了单元格以处理包含1行数据的案例，未经测试：|

我会首先给出我的解决方案，这个应该快得多，因为它首先将单元格读入内存

请评论，如果它不起作用或您还有其他问题

Sub DeleteCells()


Dim ws As Worksheet
Dim i As Long
Dim h As Long
Dim MColumn As Variant  ' for convinence
Dim HColumn As Variant
Dim IColumn As Variant
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Cover" Then  'matching the target sheet
    ' matching the rows where column M's date matches column H's date
        'starting row num is 12
        With ws ' for simplifying the code
            h = .Range("H" & .Rows.count).End(xlUp).Row
            If h = 12 Then ' CASE for 1 row only
                If Range("H12").Value = Range("M12").Value Then
                    Range("I12:I13").Value = ""
                End If

            ElseIf h < 12 Then
                ' do nothing

            Else
                ReDim HColumn(1 To h - 11, 1 To 1)
                ReDim MColumn(1 To h - 11, 1 To 1)
                ReDim IColumn(1 To h - 10, 1 To 1)
                ' copying the data from worksheet into 2D arrays
                HColumn = .Range("H12:H" & h).Value
                MColumn = .Range("M12:M" & h).Value
                IColumn = .Range("I12:I" & h + 1).Value

                For i = LBound(HColumn, 1) To UBound(HColumn, 1)
                    If Not IsEmpty(HColumn(i, 1)) And Not IsEmpty(MColumn(i, 1)) Then
                        If HColumn(i, 1) = MColumn(i, 1) Then
                            IColumn(i, 1) = ""
                            IColumn(i + 1, 1) = ""
                        End If
                    End If
                Next i
                'assigning back to worksheet cells
                .Range("H12:H" & h).Value = HColumn
                .Range("M12:M" & h).Value = MColumn
                .Range("I12:I" & h + 1).Value = IColumn
            End If

        End With
    End If
Next ws
Application.ScreenUpdating = True
End Sub

找不到匹配数据值的低效代码

1 个答案: