VBA - 只在一列中運行宏

我的代碼正好按照我想要的方式工作，但我不想讓它跳到另一列。我只想讓我的宏在C列內運行，然後退出。我是新來的VBA在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

來源

2012-09-17 cheapkid1

如果你描述你想要的宏來完成（不是它不應該這樣做）什麼會更容易些。 –

我的理由是不清楚。從「C1」開始，向下看活動單元區域，一旦發現除了當前區域中的頂部單元之外（僅在組合C內），將FormulaR1C1 =「= R [-1] C」應用於這些單元中的每一個（實質上使頂部單元格可編輯，並且該區域中的所有單元格將反映相同），在更改這些單元格公式之後，轉到C列中下一個活動單元格區域的下方，並重復執行相同的操作該地區等... – cheapkid1

這是我有，它不漂亮，但它的作品。我兩邊添加一列，然後把他們趕走宏通過整列去後：

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

來源

2012-09-26 18:13:10 cheapkid1

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

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

來源

2012-09-17 15:31:24

謝謝丹尼爾，但是，只有在C列的任何一方沒有任何東西的情況下，只有工作。如果你有這樣的事情呢？：！[Valid XHTML]（http：//i42.photobucket的.com /專輯/ E326/cheapkid1/vbamacro.jpg）。 – cheapkid1

如果我在C列的任一側填充了電池，該怎麼辦？我只想讓宏只專注於C列。例如，請參閱我上面有效的html鏈接。任何幫助，將不勝感激。 – cheapkid1

@ cheapkid1我看到你的形象，我只是不明白。你是說你想讓代碼不會改變C列以外的任何東西嗎？如果是這樣，你應該重新考慮使用CurrentRegion。 –

VBA - 只在一列中運行宏

回答

相關問題