簡體   English   中英

在 excel 宏中復制和粘貼時出現問題

[英]Problem copying and pasting in excel macro

當在“N4:N203”中檢測到“加2點”時,我需要在“E4:K4”中的相應單元格中加2。 然后將“AB4:AB203”復制到“O4:O203”到“O4:O203”。

Sub Moving_tees_add_2()
Dim PointsToAdd As Integer

    PointsToAdd = 2

        Sheets("MEMBERS1").Select
Application.ScreenUpdating = False
            Range("C4").Select

    Do Until ActiveCell.Row = 204

        If ActiveCell.Range("L1").Value = ("Add 2 points") Then
        If ActiveCell.Range("C1").Value <> "n/a" Then ActiveCell.Range("C1").Value = ActiveCell.Range("C1").Value + PointsToAdd
        If ActiveCell.Range("D1").Value <> "n/a" Then ActiveCell.Range("D1").Value = ActiveCell.Range("D1").Value + PointsToAdd
        If ActiveCell.Range("E1").Value <> "n/a" Then ActiveCell.Range("E1").Value = ActiveCell.Range("E1").Value + PointsToAdd
        If ActiveCell.Range("F1").Value <> "n/a" Then ActiveCell.Range("F1").Value = ActiveCell.Range("F1").Value + PointsToAdd
        If ActiveCell.Range("G1").Value <> "n/a" Then ActiveCell.Range("G1").Value = 
    ActiveCell.Range("G1").Value + PointsToAdd
        If ActiveCell.Range("H1").Value <> "n/a" Then ActiveCell.Range("H1").Value =  
    ActiveCell.Range("H1").Value + PointsToAdd
        If ActiveCell.Range("I1").Value <> "n/a" Then ActiveCell.Range("I1").Value = 
    ActiveCell.Range("I1").Value + PointsToAdd
        
        If ActiveCell.Range("C1").Value <> "n/a" Then ActiveCell.Range("Q1").Value = 
    ActiveCell.Range("Q1").Value + PointsToAdd
        If ActiveCell.Range("D1").Value <> "n/a" Then ActiveCell.Range("R1").Value = 
    ActiveCell.Range("R1").Value + PointsToAdd

    Range("AB4:AB203").Select
    Selection.Copy
    Range("O4:O203").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveCell.Range("A1").Select
    '
    '        Selection.ClearContents
    Range("N4:N203").Select
        Selection.ClearContents
    End If

        ActiveCell.Offset(1, 0).Range("A1").Select
    
    Loop

沒有所有選擇/激活:

Sub Moving_tees_add_2()
    Dim PointsToAdd As Long, rw As Long, ws As Worksheet, c As Range

    Set ws = ThisWorkbook.Sheets("MEMBERS1") 'use a worksheet reference
    PointsToAdd = 2

    Application.ScreenUpdating = False
            
    For rw = 4 To 204
        With ws.Rows(rw)
            If .Columns("N").Value = "Add 2 points" Then
                'loop over the range to be incremented
                For Each c In .Range("E1:K1,S1:T1").Cells
                    If c.Value <> "n/a" Then c.Value = c.Value + PointsToAdd
                Next c
                'you can directly assign the value from one range to another,
                '  without copy/pastespecial
                ws.Range("O4:O203").Value = ws.Range("AB4:AB203").Value
            End If
        End With
    Next rw

End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM