Excel VBA - 特定のテキストを含む行を削除するためのマクロへの機能の追加

Question

このサイトとExcelの新機能です。私はスプレッドシートの作成に取り組んできました。自分自身と私のチームの他のメンバーのためにスムーズにするために、スプレッドシートを作成し、それをできる限り自動化することによって、私のやり方をぼかしました。それは私が望むタスクのほとんどを実行しますが、残っているものはまだいくつかあります。それが現在立っているとしてここに私のコードは次のとおりです。

Sub Setup() 
' 
' Setup Macro 
' 
' Keyboard Shortcut: Ctrl+e 
' 
Rows("1:3").Select 
Application.CutCopyMode = False 
Selection.delete Shift:=xlUp 
Cells.Select 
ActiveWorkbook.Worksheets("Panel1").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Panel1").Sort.SortFields.Add Key:=Range("C1:C18") _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("Panel1").Sort 
    .SetRange Range("A1:Q18") 
    .Header = xlGuess 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Columns("B:B").Select 
Cells.Replace What:="RTA", Replacement:="DELETE", LookAt:=xlWhole, _ 
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ 
    ReplaceFormat:=False 
Columns("C:C").Select 
Selection.Copy 
ActiveWindow.ScrollColumn = 2 
ActiveWindow.ScrollColumn = 3 
ActiveWindow.ScrollColumn = 4 
ActiveWindow.ScrollColumn = 5 
Columns("O:O").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ 
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
Columns("O:P").Select 
With Selection 
    .VerticalAlignment = xlCenter 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .MergeCells = False 
End With 
Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
With Selection.Borders(xlEdgeLeft) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
With Selection.Borders(xlEdgeTop) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
With Selection.Borders(xlEdgeBottom) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
With Selection.Borders(xlEdgeRight) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
With Selection.Borders(xlInsideVertical) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
With Selection.Borders(xlInsideHorizontal) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThin 
End With 
Columns("N:N").Select 
ActiveWindow.LargeScroll ToRight:=-1 
Columns("A:N").Select 
Range("N1").Activate 
Selection.EntireColumn.Hidden = True 
End Sub 

私は現在、ほとんどのに苦しんだ事は、特定のテキスト文字列を検索し、それを含む行全体を削除します。このマクロに機能を追加しています。多くの人がオートフィルタの使用を提案しているのを見たことがありますが、私は行を完全に削除する必要があります。私はまた、本当に素晴らしいスタンドアロンソリューションをたくさん見つけましたが、私はこれらのマクロをどのように新しいマクロにするのかを理解できないようです。また、私は、Find and Rowsを最初に実行した場合、その行を削除するだけで、ワークシート全体を削除してしまったと考えて、Delete Sheet Rowsアクションをマクロに組み込もうとしました。

私が述べたように、今では、Delete Rowsルートを実行しようとしていたので、Find（RTA）とReplace（DELETE）ですが、最終的には、テキストRTAを作成し、それを含む行を削除します。

さらに、これを2つのワークシート（Panel1、Panel2）で同時に実行する方法があるのですか、それとも両方とも独立して実行する必要がありますか？

ご協力いただきありがとうございます。私は非常に感謝しています。私は自分自身で解決策を試し続けようとしていますが、明らかに私はこの仕事に多くの時間を費やしてきました...

Answer 1

これを試すことができます。サブルーチンは、指定された範囲内の特定の文字列を検索し、その文字列を含むすべての行（および行全体）を削除します。

Sub CleanRange(R As Range, T As String) 
Dim I As Long, F As Object 
Dim M As Long, N As Long, P As Long, Q As Long 
M = R.Row 
N = R.Column 
P = M + R.Rows.Count - 1 
Q = N + R.Columns.Count - 1 
I = M 
While I <= P 
    Set F = Range(Cells(I, N), Cells(I, Q)).Find(T, LookIn:=xlValues) 
    If F Is Nothing Then 
     I = I + 1 
    Else 
     Rows(I).Delete 
     P = P - 1 
    End If 
Wend 
End Sub 

あなたは、単一の列にTを探しているなら、あなたは直接細胞（I、K）.Valueのを簡素化し、使用することができインスタンス

Call CleanRange(Range("A1:C8"), "2") 

ため

コール。

これを適用して、複数のシートを操作したり、複数の文字列を検索したりすることができます。

---

あなたは常に列Bに探している場合は、一方では、代わりのために、より明白で、重要である

Sub CleanRange(R As Range, T As String) 
Dim I As Long 
Dim M As Long, N As Long, P As Long, Q As Long 
M = R.Row 
N = R.Column 
P = M + R.Rows.Count - 1 
Q = N + R.Columns.Count - 1 
I = M 
While I <= P 
    If Cells(I, 2).Value = T Then 
     Rows(I).Delete 
     P = P - 1 
    Else 
     I = I + 1 
    End If 
Wend 
End Sub 

---

あるいは

Sub CleanRange(R1 As Long, R2 As Long, T As String) 
Dim I As Long 
Dim M As Long, N As Long, P As Long, Q As Long 
M = R1 
P = R2 
I = M 
While I <= P 
    If Cells(I, 2).Value = T Then 
     Rows(I).Delete 
     P = P - 1 
    Else 
     I = I + 1 
    End If 
Wend 
End Sub 

お知らせを書くことができますなぜなら、行を削除すると、訪問する最後の行が上に移動するので、ループの制限が減少するからです（P = P - 1があるからです）。あなたが別のサブでこのサブを呼び出したい場合は

---

その後、あなたはあなたの応答のためにそんなに

Sub Something(...) 
!Declarations 
!Do whatever you want here (initialisation...) 

!Then do the call, with the appropriate range and string, here is an example 
Call CleanRange(Range("A1:C100"), "2") 

!Do whatever you want 
End Sub