VBAマクロ条件に基づいてセルを次の列の先頭に移動

Question

複数の列になるスプレッドシートデータがありますが、列数はエントリ数に応じて1から8まで変化します。私はこの形式で同じ2文字で始まるいくつかのエントリを持っています：CF 12456これらのうちの1つ、またはこれらの多くの "CF 12345"が存在することがあります。 （すなわち、6列のデータがある場合、「CF12345」列は列6の右側にあるはずである）新しい列に「CF12345」のセルを挿入する。このコードは、すべての "CF 12345"を列Iに移動することを除いてすべてのことを行います（はい、私はそのコードが実行するように指示しているためです）。ここでは、コードは次のとおり使用される範囲のパターンに一致する各見つかったセルの列に

Sub DiscrepancyReportMacroStepTwo() 

    'Step 4: Find CF cells move to the top of their own column 
    Dim rngA As Range 
    Dim cell As Range 

    Set rngA = Sheets("Sheet1").Range("A2:H500") 
    For Each cell In rngA 
     If cell.Value Like "*CF*" Then 
      cell.Copy cell.Offset(0, 1) 
      cell.Clear 
     End If 
    Next cell 
End Sub 

Answer 1

反復、スワップトップセルとその値。すべてのセルの値を保持する必要がある場合は、スワップする必要がある現在の最上部の行を追跡する必要があります。

ところで、問題の説明に間違いがない限り、あなたのパターンは"CF *"ではなく、"*CF*"ではないようです。このコードは、ワークシートに存在するすべての値を保持しながら、すべてのCF *セルを一番上に移動します。

Sub DiscrepancyReportMacroStepTwo() 
    Dim cel As Range, col As Range, curRow As Long, temp 
    For Each col In Sheets("Sheet1").UsedRange.Columns 
    curRow = 1 
    For Each cel In col.Cells 
     If cel.Value2 Like "CF *" Then 
     ' Swap values of the cell and a cel from top of the column (at curRow) 
     temp = col.Cells(curRow).Value2 
     col.Cells(curRow).Value2 = cel.Value2 
     cel.Value2 = temp 
     curRow = curRow + 1 
     End If 
    Next cel 
    Next col 
End Sub 

EDIT

上記のコードは、カラムの上部にCF *細胞を移動させます。新しい別の列にそれらを追加するには、これを使用する：

Sub DiscrepancyReportMacroStepTwo() 
    Dim lastColumn As Long, lastRow As Long, cel As Range, curRow As Long 
    With Sheets("Sheet1") 
    lastColumn = .Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column 
    lastRow = .Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).row 

    For Each cel In .Range("A2", .Cells(lastRow, lastColumn)) 
     If cel.Value2 Like "CF *" Then 
     curRow = curRow + 1 
     .Cells(curRow, lastColumn + 1).Value2 = cel.Value2 
     cel.Clear 
     End If 
    Next cel 
    End With 
End Sub 

Answer 2

あなたは「CF *」値を検索するために正規表現を使用することができますが、続く「CF」で始まる値のみを選択することを保証します問題文ごとに5桁。 "^CF [\d]{2,5}$"

Option Explicit 

Sub Move2LastCol() 
    Dim sht As Worksheet 
    Set sht = Worksheets("Sheet1") 

    Dim regEx As Object 
    Set regEx = CreateObject("vbscript.regexp") 
    regEx.Pattern = "^CF [\d]{5}$" 

    Dim r As Integer, c As Integer, lastRow As Integer, lastCol As Integer 
    Dim tmp As String 
    With sht 
    lastCol = .Cells.Find(What:="*", SearchOrder:=xlColumns, _ 
       SearchDirection:=xlPrevious, LookIn:=xlValues).Column + 1 
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    For r = 1 To lastRow: 
     Dim c1 As Integer: c1 = lastCol 
     For c = 1 To .Cells(r, lastCol).End(xlToLeft).Column: 
     If regEx.Test(.Cells(r, c)) Then 
      tmp = .Cells(r, c).Value2 
      .Cells(r, c).Clear 
      .Cells(r, c1).Value2 = tmp 
      c1 = c1 + 1 
      Exit For 
     End If 
     Next 
    Next 

    End With 

End Sub