Excel宏：我想添加一列到一個範圍，並調用一個函數來填充它

下面是一個宏，我們用它來構建一個工作表，其中包含一個較大的工作表的子集。當循環在我們的服務器名稱數組中找到匹配項時，它將它複製到新的工作表中。我想在複製過程中將新列添加到新工作表中。得到這個工作後，我想通過調用一個函數來填充這個字段。我們試圖建立一個顯示服務器是否爲「關鍵」服務器的列。簡單的y/n從一個看起來在關鍵服務器陣列中的函數返回。我不需要該函數，只需添加一列並在循環中填充它即可。Excel宏：我想添加一列到一個範圍，並調用一個函數來填充它

我會將較大的循環粘貼下去，但這裏是一行代碼，如果發現新的工作表，它將複製範圍。在這裏，我想添加或複製一個由功能填充的列：

Rcount = Rcount + 1 
Source.Range("A" & Rng.Row & ":R" & Rng.Row).Copy NewSh.Range("A" & Rcount & ":R" & Rcount)

這是查詢頭腦的大循環。這可能是有用的，或者至少證明這個代碼被用於：

With Source.Range("A1:R9000") 

    'Find where the actual data we need starts 
    Set Rng = .Find(What:="Client", _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlFormulas, _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 

    intColorMatch = 0 

    If Not Rng Is Nothing Then 
     FirstAddress = Rng.Address 
     Do 
      Set Rng = .FindNext(Rng) 
      If (Rng.Interior.Color = 13421772) Then 
       intColorMatch = intColorMatch + 1 
      End If 

      If (intColorMatch < 2) = False Then 
       StartRow = Rng.Row 
       Exit Do 
      End If 

     Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
    End If 


    Source.Range("A" & StartRow & ":R" & StartRow + 1).Copy NewSh.Range("A1:R2") 

    Rcount = 2 
    FirstAddress = 0 

    For I = LBound(MyArr) To UBound(MyArr) 

     'If you use LookIn:=xlValues it will also work with a 
     'formula cell that evaluates to "@" 
     'Note : I use xlPart in this example and not xlWhole 
     Set Rng = .Find(What:=MyArr(I), _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlFormulas, _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Not Rng Is Nothing Then 
      FirstAddress = Rng.Address 
      Do 
       If Rng.Row >= StartRow Then 
        Rcount = Rcount + 1 
        Source.Range("A" & Rng.Row & ":R" & Rng.Row).Copy NewSh.Range("A" & Rcount & ":R" & Rcount) 

       ' Use this if you only want to copy the value 
        ' NewSh.Range("A" & Rcount).Value = Rng.Value 
       End If 

       Set Rng = .FindNext(Rng) 
      Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
     End If 
    Next I 
End With

來源

2017-06-06 JustJohn

如果「新的」列你是想填充是你複製的數據結束後，你是不是真的添加一列 - 你只是填充一個現有的空列。

如果是這樣，你可以這樣說

NewSh.Cells(Rcount, "Q").Formula = "=whatever_formula_you_want"

（或使用FormulaR1C1如果是比較容易）。

或者，如果你只是想插入值有（你在你的VBA代碼計算），它只是

NewSh.Cells(Rcount, "Q").Value = the_value_I_want

來源

2017-06-07 19:26:28 YowE3K

Excel宏：我想添加一列到一個範圍，並調用一個函數來填充它

回答

相關問題