VBA-仅在一列中运行宏

我的代码完全按照我想要的方式工作，但是我不希望它跳到另一个专栏。我只希望宏在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

Sub宏5（）
变暗Rng As范围
调光范围
Dim rngArea As系列
设置Rng=范围（“C1”）
设置RngEnd=单元格（Rows.Count，Rng.Column）。结束（xlDown）
如果RngEnd.Row

如何更改搜索范围，以便只搜索C列

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

---

您可以更改搜索范围，只搜索C列吗

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

---

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

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

---

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

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

---

如果你描述一下你想要宏做什么（而不是它不应该做什么），那就容易多了。我的解释是，我的解释不够清晰。从“C1”开始，向下查找活动单元格区域，一旦找到，选择当前区域中除顶部单元格以外的所有单元格（仅在ComColumn C内），在更改这些单元格公式后，将FormulaR1C1=“=R[-1]C”应用于这些单元格中的每个单元格（基本上使顶部单元格可编辑，该区域中的所有单元格将反映相同的内容），沿着向下的方向转到C列中的下一个活动单元格区域，并对该区域再次执行相同的操作，依此类推……如果您描述希望宏执行的操作（而不是不应该执行的操作），会更容易。我的解释不清楚。从“C1”开始，向下查找活动单元格区域，一旦找到，选择当前区域中除顶部单元格以外的所有单元格（仅在ComColumn C内），在更改这些单元格公式后，将FormulaR1C1=“=R[-1]C”应用于这些单元格中的每个单元格（基本上使顶部单元格可编辑，该区域中的所有单元格将反映相同的内容），向下转到C列中的下一个活动单元格区域，并对该区域再次执行相同的操作，以此类推…谢谢Daniel，但是，只有在C列两侧没有任何内容时，该操作才会起作用。如果有类似的内容，该怎么办？：！。如果我在C列的两边都填充了单元格呢？我只希望宏只关注C列。例如，请参阅上面我的有效html链接。任何帮助都将不胜感激。@Kid1我看到了你的图像，我只是不明白。你是说你希望代码不改变C列之外的任何内容吗？如果是这样，你应该重新考虑使用CurrentRegion。是的，我就是这么说的。非常感谢，这是有道理的。我将尝试另一种方法。有什么建议我应该用什么来代替吗？我不知道你想做什么。。。如果您所要做的只是将C列的公式更新为等价于R[-1]C，那么运行以下命令：

Range（“C2”，Range（“C2”）.End（xlDown）.Address.FormulaR1C1=“=R[-1]C”

将对除C1之外的所有内容执行此操作。这就是我理解你解释的原因，但它似乎太简单了，无法满足你的要求。谢谢丹尼尔，但是这只有在C列两边都没有任何内容的情况下才有效。如果你有这样的内容呢？：！。如果我在C列的两边都填充了单元格呢？我只希望宏只关注C列。例如，请参阅上面我的有效html链接。任何帮助都将不胜感激。@Kid1我看到了你的图像，我只是不明白。你是说你希望代码不改变C列之外的任何内容吗？如果是这样，你应该重新考虑使用CurrentRegion。是的，我就是这么说的。非常感谢，这是有道理的。我将尝试另一种方法。有什么建议我应该用什么来代替吗？我不知道你想做什么。。。如果您所要做的只是将C列的公式更新为等价于R[-1]C，那么运行以下命令：

Range（“C2”，Range（“C2”）.End（xlDown）.Address.FormulaR1C1=“=R[-1]C”

将对除C1之外的所有内容执行此操作。这就是我理解你解释的原因，但这似乎太简单了，不可能是你想要的。