Question

我有一些电子表格数据将在多个列中，但列数将根据条目数从1到8不等。我有一些以这种格式以相同的2个字符开头的条目：CF 12456这些中只有一个或多个“CF 12345”一旦数据分散到均匀分布的列中，我需要移动所有将具有“CF 12345”的单元格放入将成为最后一列数据的新列中（即，如果有6列数据，则“CF 12345”列应位于第6列的右侧）。这段代码完成了所有这些，除了它将所有“CF 12345”移动到第一列（是的，我知道它，因为这是代码告诉它要做的）。这是代码：

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

修改

上面的代码将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个数字，根据您的问题陈述。如果您不知道数字的数字，但知道它将在2到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

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

2 个答案: