VBA - 仅在一列中运行宏

VBA - Run macro in only one column

提问by cheapkid1

I have the code working exactly the way I'd like to, however I don't want it to skip onto another column. I just want my macro to run inside column C then exit. I am new to VBA in excel, so please pardon my faults. Any help would be much appreciated. Thanks in advance.

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

Here is something I modified from something I found that will essentially do the same thing, however it puts the first cells value into all cells in the range. And this macro actually stays in Column C, since I found recently because it's not a region, it's a range.

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

Is there a way to change the following to add a formula to all cells in the range that points to the first cell in the range?

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

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

采纳答案by cheapkid1

Here's what I have, it's not pretty but it works. I added a column on both sides then removed them after the macro went through the entire column:

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

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

回答by Daniel

How about you change your search_range, so that you only search Column C?

你如何改变你的search_range，让你只搜索列C？

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