Question

我的代码完全按照我想要的方式工作，但是我不希望它跳到另一列。我只想让我的宏在C列内运行然后退出。我是excel的VBA新手，所以请原谅我的错误。任何帮助将非常感激。提前谢谢。

    Sub CopyValuetoRange()
'
' CopyValuetoRange Macro

Dim search_range As Range, Block As Range, last_cell As Range
  Dim first_address$
  Set search_range = ActiveSheet.UsedRange
  Set Block = search_range.Find(what:="*", _
    after:=search_range.SpecialCells(xlCellTypeLastCell), _
    LookIn:=xlValues, searchorder:=xlColumns, searchdirection:=xlDown)
  If Block Is Nothing Then Exit Sub

  Set Block = Block.CurrentRegion
  first_address$ = Block.Address
  Do
    Block.Select
    Selection.End(xlDown).Select
    ActiveCell.CurrentRegion.Rows(2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "=R[-1]C"

    'MsgBox "Next Block Range"
    Set last_cell = Block.Cells(Block.Rows.Count)
    Set Block = search_range.FindNext(after:=last_cell).CurrentRegion
  Loop Until Block.Address = first_address$ 'ActiveSheet.Range("C26").End(xlDown).Row


End Sub

这是我从我发现的基本上做同样事情的东西修改的东西，但是它将第一个单元格值放入范围内的所有单元格中。这个宏实际上保留在C列，因为我最近发现因为它不是一个区域，所以它是一个范围。

有没有办法更改以下内容，将公式添加到指向范围中第一个单元格的范围内的所有单元格？

Sub Macro5()

    Dim Rng As Range
    Dim RngEnd As Range
    Dim rngArea As Range

        Set Rng = Range("C1")
        Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlDown)
        If RngEnd.Row < Rng.Row Then Exit Sub

        Set Rng = Range(Rng, RngEnd)

        On Error GoTo ExitSub
        Set Rng = Rng.SpecialCells(xlCellTypeConstants)

        For Each rngArea In Rng.Areas
            rngArea.Value = rngArea.Cells(Rng.Rows.Count, 1).Value
        Next rngArea


ExitSub:
    ' Macro will exit here if the range is empty.

End Sub

Answer 1

如何更改search_range，以便只搜索C列？

  Set search_range = ActiveSheet.Range("C:C")
  Set Block = search_range.Find(what:="*", _
    LookIn:=xlValues, searchorder:=xlColumns, searchdirection:=xlDown)

Answer 2

这就是我所拥有的，它不是很漂亮，但它有效。我在两侧添加了一列，然后在宏遍历整个列后将其删除：

Sub CopyFirstCellInRangeInOneColumn()
'
' CopyValuetoRange Macro
Dim search_range As Range, Block As Range, last_cell As Range
  Dim first_address$
  ''
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  ''
  Set search_range = ActiveSheet.Range("D:D")
  Set Block = search_range.Find(what:="*", _
    LookIn:=xlValues, searchorder:=xlColumns, searchdirection:=xlDown)

  'Set search_range = ActiveSheet.UsedRange
  'Set Block = search_range.Find(What:="*", _
  '  After:=search_range.SpecialCells(xlCellTypeLastCell), _
  '  LookIn:=xlValues, SearchOrder:=xlColumns, SearchDirection:=xlDown)


  If Block Is Nothing Then Exit Sub

  Set Block = Block.CurrentRegion
  first_address$ = Block.Address
  Do
    Block.Select
    Selection.End(xlDown).Select
    ActiveCell.CurrentRegion.Rows(2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "=R[-1]C"

    MsgBox "Next Block Range"
    Set last_cell = Block.Cells(Block.Rows.Count)
    Set Block = search_range.FindNext(After:=last_cell).CurrentRegion
  Loop Until Block.Address = first_address$ 'ActiveSheet.Range("C26").End(xlDown).Row

    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft


End Sub

VBA - 仅在一列中运行宏

2 个答案: