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）を使用して、スプレッドシートの見方どおりに一致するものが1つあることを確認しました。マクロは、if式からの確認にもかかわらず、この一致を検出しません。 。セルI100およびI101は、ゼロにする必要があるときにゼロ以外の値を持ちます。

2）コードは実行されますが、180行のデータを3枚通過するのに約3分かかります。より速く、より効率的に実行するために何ができるでしょうか？最大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 に答える