Question

下面是一个宏，我们用它来构建一个包含较大工作表子集的工作表。当循环在我们的服务器名称数组中找到匹配项时，它会将其复制到新工作表中。我想在复制过程中向新工作表添加一个新列。在完成这项工作后，我想通过调用函数来填充此字段。我们正试图建立一个列，显示服务器是否是一个关键的＆＃34;服务器。简单的y / n从一个看起来在关键服务器数组中的函数返回。我不需要这个功能，只是如何添加一个列并在循环中填充它。

我会将大循环粘贴到更远的位置，但是如果找到新工作表，则会在一个范围内复制单独的代码行。在这里，我想添加或复制一个由函数填充的列：

 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

Answer 1

如果＆＃34;新＆＃34;您想要填充的列是在复制数据结束后，您实际上并未添加列 - 您只是填充现有的空列。

如果是这样，你可以说像

这样的话

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

（如果更容易，请使用FormulaR1C1。）

或者，如果你只想在那里插入一个值（你在VBA代码中计算），那就是

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

Excel宏：我想在一个范围中添加一列并调用一个函数来填充它

1 个答案: