VBA - 仅在一列中运行宏答案

【问题标题】：VBA - Run macro in only one columnVBA - 仅在一列中运行宏
【发布时间】：2012-09-17 15:01:48
【问题描述】：

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

【问题讨论】：

如果你描述你想要宏做什么（而不是它不应该做什么）会更容易。
我很抱歉没有更清楚。从“C1”开始，向下查找活动单元格区域，一旦找到，选择当前区域中除顶部单元格之外的所有单元格（仅在 C 列内），将 FormulaR1C1 = “=R[-1]C” 应用于每个单元格（基本上使顶部单元格可编辑，并且该区域下方的所有单元格将反映相同），更改这些单元格公式后，向下方向转到 C 列中的下一个活动单元格区域，并再次执行相同的操作那个地区等等......

标签： vba

【解决方案1】：

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

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

【讨论】：

谢谢丹尼尔，但是只有在 C 列的两边都没有任何东西的情况下才有效。如果你有这样的东西怎么办？：！Valid XHTML。
如果我在 C 列的任一侧填充了单元格怎么办？我只希望宏只关注 C 列。例如，请查看我上面的有效 html 链接。任何帮助将不胜感激。
@cheapkid1 我看到了你的图片，我只是不明白。您是说您希望代码不更改 C 列之外的任何内容吗？如果是这样，您应该重新考虑使用 CurrentRegion。
是的，这就是我要说的。非常感谢，有道理。我会尝试不同的方法。有什么建议我应该改用吗？？
我不确定您要做什么...如果您要做的只是将 C 列的公式更新为等于 "=R[-1]C" 然后运行：Range("C2", Range("C2").End(xlDown).Address).FormulaR1C1 = "=R[-1]C" 将对除 C1 之外的所有内容执行此操作。这就是我理解你在解释什么的方式，但它似乎太简单了，无法成为你想要的。

【解决方案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

【讨论】：