VBA宏根据条件将单元格移动到下一列的顶部

我有一些电子表格数据，将在多个列，但列的数量将从1到8根据条目的数量变化。在这种格式中，我有一些条目以相同的2个字符开头：CF 12456数据分散到均匀分布的列中后，可能只有其中的1个或多个“CF 12345”，我需要将带有“CF 12345”的所有单元格移动到新列中，该列将是最后一列数据（即，如果有6列数据，则“CF 12345”列应位于第6列的右侧）。此代码执行所有操作，但它将所有“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

---

在使用范围的列上迭代，对于找到的与模式匹配的每个单元格，将其值与顶部单元格交换。如果需要保留所有单元格值，则需要跟踪需要交换的当前顶部行

顺便说一下，您的模式似乎是

“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

编辑

上述代码将

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

---

您可以使用正则表达式查找“CF*”值，这将确保您根据问题陈述只选择以“CF”开头、后跟5位数字的值。如果您不知道数字的#，但知道它将在2到5位之间，则可以将正则表达式模式更改为：

“^CF[\d]{2,5}$”

---

谢谢。代码很好用，但是我想把所有的“CF*”移到一个新的列中。你的代码移动了“CF*”“s到当前所在列的顶部。我希望所有的CF都在右边的最后一列中，只有属于CFs的单元格才会在那里。现在的CF值将始终位于最后一列数据的末尾。我基本上只想将这些CF值剪切/粘贴到一个新列中（右侧的最后一列，即1 2 3 4 5我希望CF值位于第5列）@jasonkeithmcmy我认为编辑中的新代码应该可以实现它。但是请注意，我们只匹配

CF*

，为了保持简单，我们不验证它后面是否有数字，因此我们保持简单并避免

Regexp

，但是如果这一要求很强，（匹配更具体的模式），那么我们需要添加一些

Regexp

（即，与另一个答案相同）不，将有多个CF值，并且模式始终相同：CF 12345（因此字母CF后跟5个数字。模式永远不会更改）。如果模式保持不变，则可能不必使用正则表达式。可能使用“CF”之类的值？您可以保持正则表达式在这种情况下的状态。我修改了答案，以便将所有“CF”值复制到最后一列，并根据需要复制到上一列。

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