VBA find allを選択し、隣接するすべてのセルを右に移動します。

Question

私は仕事中のシステムによって生成されたブックをソートするマクロを作成しようとしています。私はこのサイト上の他の投稿からいくつかのコードを一緒にchopshopしようとしましたが、成功しませんでした。

「IN」または「OUT」のいずれかを含むセルに対して列Aを検索し、これらのセルの右側にあるすべてのセルを右に移動します。

私は最初の出力のために働くいくつかのコードを持っていますが、最初の出力を準備するだけですが、なぜ動作しないのかわかりますが、修正する方法はわかりません。

すべてのヘルプははるかに、

Sub Data_only() 
' 
' Reworks_Data_only Macro 
' 
' Keyboard Shortcut: Ctrl+k 
' 
    Columns("J:AB").Select 
    Selection.ClearContents 
    Cells.Select 
    Cells.EntireColumn.AutoFit`enter code here` 
' ^Cuts out unused columns and autofits the rest 
    Columns("A:A").Select 
    Selection.Find(What:="in", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
     :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 
'  ^Searches Column A for "IN" 
     ActiveCell.Offset(, 1).Select 
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
'  ^Selects the found cell and shift the whole row to the right 

End Sub 

EDIT おかげで、高く評価されるだろう。これは、変更しようとしてファイルイムのモックアップで、通常は数百バッチと、より多く存在することになります実行可能でなければなりません。 batches mock up

Answer 1

何かが可能です。 ..

Option Explicit 

Public Sub Data_only() 
    MoveByFind "IN" 
    MoveByFind "OUT" 
End Sub 

Public Function MoveByFind(FindString As String) 
    Dim Found As Range 
    Set Found = Columns("A:A").Find(What:=FindString, LookIn:=xlFormulas, LookAt:=xlWhole, _ 
     SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 

    If Not Found Is Nothing Then 
     Dim firstAddress As String 
     firstAddress = Found.Address 'remember first find for no endless loop 

     Do 
      Found.Offset(0, 1).Insert Shift:=xlToRight 'move cells right 
      Set Found = Columns("A:A").FindNext(After:=Found) 'find next 
     Loop While Not Found Is Nothing And Found.Address <> firstAddress 'loop until end or nothing found 
    End If 
End Function 

Answer 2

あなたはむしろ、検索機能を使用するよりも、単純なループでこれを行うことができます。

Dim i as Long, LR as Long 
LR = Cells(Rows.Count,1).End(xlUp).Row 
For i = 2 to LR 'Assumes you have a header in row 1 
    If Cells(i,1).Value = "IN" OR Cells(i,1).Value = "OUT" Then 
     Cells(i,2).Insert Shift:=xlToRight 
    End If 
Next i 

注イン、アウトは、大文字と小文字が区別されていること。

Find関数でもこれを行うことができますが、すべてを見つけるか、find nextを使用してコード内で.insertを使用します。

---

編集：

が問題に隠された文字であると仮定すると、InStr関数を使用することができます：あなたはFind機能を使用したい場合はそのような

Dim i As Long, LR As Long, j As Integer, k As Integer 
LR = Cells(Rows.Count, 1).End(xlUp).Row 
For i = 2 To LR 'Assumes you have a header in row 1 
    j = InStr(Cells(i, 1).Value, "IN") 
    k = InStr(Cells(i, 1).Value, "OUT") 
    If j > 0 Or k > 0 Then 
     Cells(i, 2).Insert Shift:=xlToRight 
    End If 
Next i