0

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

代码意图：我有一个数据表，4 列（F、G、H 和 I）宽，X 行长（X 通常在 5 到 400 之间）。我在 M 列中有一个日期列表，通常不超过 8 个日期。表的 H 列也包含日期。我想找到两列（H 和 M）中的日期，每当它们出现时，转到 I 列中的同一行并将其值设置为零，然后将其值设置为零（因此，如果匹配项在 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 行为零。有什么办法可以防止它从填充零，然后将其留空？

之后我在 I 列上使用了相关函数，并且 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
4

1 回答 1

1

编辑：测试代码，是否适用于从第 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
于 2012-12-20T10:52:32.247 回答