在單張工作表中查找多個列表的標題並從底部自動填充公式

希望我的標題清楚。我試圖首先在列表中找到標題「WT/PC」，到達列表的底部，將公式直接複製到標題中，然後找到下一個「WT/PC」實例「在工作表上（它們並不總是在同一列中），然後對它做同樣的事情。我想這樣做約10-20次。我有一個Macro Recorder Code和一些我已經添加的組合。我已經找到WT/PC，就到了列表的底部，但現在我有使用自動填充，以填補使用xlUp在單張工作表中查找多個列表的標題並從底部自動填充公式

樣品圖片，以幫助更好地可視化列語法問題：http://imgur.com/a/euYr1 http://imgur.com/a/euYr1 目前代碼：

Sub Formula_Fill_Using_Find() 

Dim lastRow As Long 
Dim rowCount, row_ix, temp, i As Integer 
Dim TD_COL_IX As Integer 
Dim td_value As String 
Dim td_values() As String 

' ################# 
' Count rows starting in column A 
' ################# 
For row_ix = 1 To 25 ' 25 was previously "rowCount" 

ActiveCell.Select 
Cells.Find(What:="WT/PC", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
False, SearchFormat:=False).Activate 

Selection.End(xlDown).Select 

ActiveCell.AutoFill Range(ActiveCell.Address & ":" & 
Left(ActiveCell.Address, Len(ActiveCell.Address)) & xlUp) 

Next row_ix 



End Sub

來源

2017-07-07 Anthony Richards

請使用標準上傳的圖片。 –

我的問題是在我的ActiveCell.Autofill行。無法從當前選定的單元格（公式所在的位置）獲取正確的語法，然後向上。 –

我不能使用標準上傳器，或者我會使用Mat's杯。你對我的實際問題有任何建議，而不是對我僅限於使用的格式的批評嗎？ –

試試這個：

Option Explicit 

Public Sub ReverseFill() 
    Dim ur As Range, found As Range, adr As Variant, cr As Range, lr As Long 

    Set ur = Sheet1.UsedRange 
    Set found = ur.Find("WT/PC", , xlFormulas, xlPart, xlByRows, , False) 

    If Not found Is Nothing Then 
     adr = found.Address 

     Application.ScreenUpdating = False 
     Do 
      Set cr = found.CurrentRegion:   lr = cr.Rows.Count - 1 
      cr.Columns(1).Offset(1).Resize(lr - 1).Formula = found.Offset(lr).Formula 
      Set found = ur.FindNext(found) 
     Loop While found.Address <> adr 
     Application.ScreenUpdating = True 
    End If 
End Sub

來源

2017-07-07 20:06:09

在單張工作表中查找多個列表的標題並從底部自動填充公式

回答

相關問題