VBAmacros根据标准将单元格移动到下一列的顶部

我有一些电子表格数据将在多个列，但列的数量将根据条目数从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

迭代使用的范围的列，并find与模式匹配的每个find的单元格， 将其值与顶部单元格交换 。 如果您需要保留所有的单元格值，则需要跟踪需要交换的当前最上面一行。

顺便说一句，你的模式似乎是"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

您可以使用正则expression式来查找“CF *”值，这将确保您只select以“CF”开头的值，然后按照您的问题陈述select5个数字。 如果您不知道数字的位数，但知道位数在2到5位之间，则可以将正则expression式模式更改为： "^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