VBA在粘贴到循环内部之前先评估相邻的单元格

时间:2018-09-07 17:32:07

标签: excel vba excel-vba

Excel中的以下VBA代码是从工作表(“复制模型”)复制一个节并将其粘贴到另一个工作表(“粘贴模型”)的第一个可用空白行中。

“我的输入”工作表具有一列名称和第二列。该代码将名称粘贴到“ B3”中,但是我在B4中有一个手动更改的级别,因此模型角色处于另一个级别。

我想调整代码以评估级别是否已更改,如果有,请粘贴新的相邻级别。

输入的设置方式类似(从“ B172”开始)。我想在粘贴C值之前先评估“ C”列(PL / ML)。这可以大大加快我的代码的速度。

将(名称)粘贴到“ B3”中 如果相邻级别不等于“ B4”中已有的内容,则将(级别)粘贴到“ B4”中

(Col B)  (Col C)  
Jim       PL
Bod       PL
Todd      PL
Nick      ML
Steve     ML

VBA:

Sub Loopfor()

    Sheets("Inputs").Select

    Dim rng As Range, cell As Range
    Set rng = Range("B172:B187")

    Dim copySheet As Worksheet
    Set copySheet = Worksheets("Copy Model")

    Dim pasteSheet As Worksheet
    Set pasteSheet = Worksheets("Paste model")

    ''Application.ScreenUpdating = False

    Do

        For Each cell In rng

            cell.Copy
            Range("B3").PasteSpecial Paste:=xlPasteValues

            copySheet.Range("A143:W264").Copy
            pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False

            Sheets("Inputs").Select

        Next cell

    Loop Until IsEmpty(ActiveCell.Value)

    ''Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

如果我正确理解您的意思,您是说每次C列中的值更改时(从上到下扫描时),您都希望将新值放入B4中。为此,请将以下代码放入循环中:

If cell.OffSet(0,1) <> cell.OffSet(-1,1) Then
    cell.OffSet(0,1).Copy
    Range("B4").PasteSpecial Paste:=xlPasteValues
End If