☰

宏用于查找和移动特定单元格

tag-icon • tag-icon microsoft-excel vba
宏用于查找和移动特定单元格

我需要一个宏来查找（Excel）列中A以（星号加空格）开头的每个单元格*，并将其向右移动一个单元格并向上移动一个单元格。

然后转到*列中的下一个单元格A并执行相同操作，然后下一个...直到文件末尾。

我的 Excel 版本（适用于 Mac 的 2023 V.16.72）似乎没有办法将“宏”选项卡放入选项卡阵容中，并且该阵容中没有“文件”标题......尽管我可以使用框架顶部的 Mac 选项卡选择中的“工具”标题访问 VBA。

答案1

这是另一种解决方案。它使用数组，如果用于大数据，可能会更快。你没有提到是否要对 A 列中产生的空白进行任何操作，所以我就把它们留在那里了。

Sub moveAsterisk()
    Dim lastRow As Long, wsh As Worksheet
    Set wsh = Worksheets("Sheet1")
    lastRow = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
    
    Dim sourceArr() As Variant, sourceRange As Range
    Set sourceRange = wsh.Range("A1:B" & lastRow)
    sourceArr = sourceRange
    
    Dim curVal As String
    For i = 1 To UBound(sourceArr)
        curVal = sourceArr(i, 1)
        If Left(curVal, 2) = "* " Then
            sourceArr(i, 1) = ""
            sourceArr(i - 1, 2) = curVal
        End If
    Next
    sourceRange = sourceArr
End Sub

输入：

在此处输入图片描述

输出：

在此处输入图片描述

答案2

通常，这些任务是通过一次遍历所有单元格来执行的：

Sub ReorderValues()
Dim rangeToReorder As Range ' All cells from A2 to the end of data
Dim oCell As Range          ' Single cell in column A
    Set rangeToReorder = Application.Intersect(ActiveSheet.UsedRange, [A:A]).Offset(1, 0)
    For Each oCell In rangeToReorder.Cells
        If Left(oCell.Text, 2) = "* " Then
            oCell.Copy Destination:=oCell.Offset(-1, 1)
            oCell.ClearContents
        End If
    Next oCell
End Sub

但是还有另一种方法，不需要宏。将 =IF(LEFT($A1;2)="* ";"";$A1)和 之类的公式放在=IF(LEFT($A2;2)="* ";$A2;"") 数据右侧的辅助单元格中，使用这些公式填充数据末尾的列，然后将结果值复制到原始列 A:B 中。现在可以清除辅助单元格了。

如果有必要，这个动作序列也可以写成宏：

Sub QuickReorderValues()
Dim fullData As Range
Dim firstEmptyCell As Range
Dim newValues As Range
    Set fullData = ActiveSheet.UsedRange
    Set firstEmptyCell = [A1].Offset(0, fullData.Columns.Count + 1)
    firstEmptyCell.FormulaR1C1 = "=IF(LEFT(RC1,2)=""* "","""",RC1)"
    firstEmptyCell.Offset(0, 1).FormulaR1C1 = "=IF(LEFT(R[1]C1,2)=""* "",R[1]C1,"""")"
    Set newValues = firstEmptyCell.Resize(fullData.Rows.Count, 2)
    newValues.FillDown
    fullData.Resize(, 2).Value2 = newValues.Value2
    newValues.ClearContents
End Sub

在某些条件下（例如，对于大型数据集或当 B 列已经包含一些应丢弃的值时），第二种选择是可取的。

相关内容