在单张工作表中查找多个列表的标题并从底部自动填充公式

希望我的标题清楚。我试图首先在列表中找到标题“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

在单张工作表中查找多个列表的标题并从底部自动填充公式

回答

相关问题