VBA - 단 하나의 열에서 매크로 실행

Question

코드는 원하는대로 작동하지만 다른 열로 건너 뛰지는 않습니다. 난 그냥 내 매크로가 C 열에서 실행되고 종료되도록하고 싶다. 나는 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

여기에 제가 가지고있는 것은 꽤 있지만 작동하지 않습니다. 나는 그 양쪽에 열을 추가 한 매크로 전체 칼럼을 통해 간 후에 제거 :

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 

Answer 2

검색 C 란을 검색하면 어떨까요?

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