>

행 수가 많은 시트가 있습니다. 그들 중 일부는 빨간색으로 표시됩니다. 각 빨간색 행 위에 6 개의 빈 행이 있습니다. 여기서 빨간색 행을 복사하여 그 위에있는 각 빈 행에 6 번 붙여 넣어야합니다.

시트의 빨간색 행에 액세스하고 그 위의 6 행에 내용을 붙여 넣는 방법을 알 수 없습니다. 누군가 아이디어가 있다면 정말 행복 할 것입니다!

다음은 행을 빨간색으로 필터링하는 코드입니다 (필터링 후) :

   Sub FilterByAA()
Dim lastrow As Long
Sheets("Raw Data").Activate
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:AT" & lastrow).Select
'Selection.AutoFilter Field:=2, Criteria1:="A6FC"
Selection.AutoFilter Field:=16, Criteria1:="AA", Operator:=xlFilterValues


Worksheets("Raw Data").UsedRange.Interior.ColorIndex = 3
Worksheets("Raw Data").Rows(1).EntireRow.Interior.ColorIndex = 2

End Sub

다음은 각 빨간색 행 앞에 6 개의 행을 삽입하는 코드입니다.

Sub InsertAA()
    Dim c As Range
    Set Rng = ActiveSheet.Range("P1:P7000")
    For dblCounter = Rng.Cells.Count To 1 Step -1
        Set c = Rng(dblCounter)
        If c.Value Like "AA" Then
        c.EntireRow.Insert
        c.EntireRow.Insert
        c.EntireRow.Insert
        c.EntireRow.Insert
        c.EntireRow.Insert
        c.EntireRow.Insert
    End If
    Next dblCounter
End Sub


  • 답변 # 1

    이와 같은 것을 시도해보십시오

    Private Sub Celine_N()
    Dim LongRow     As Long
    For LongRow = Cells(Rows.Count, 16).End(xlUp).Row To 2 Step -1    'Coulmn 16 is Column "P"
    If Cells(LongRow, 16).Interior.ColorIndex = 3 Then
        Rows(LongRow).Copy
        Rows(LongRow - 1).PasteSpecial xlPasteValues    'Can be replaced using For...Next Loop
        Rows(LongRow - 2).PasteSpecial xlPasteValues
        Rows(LongRow - 3).PasteSpecial xlPasteValues
        Rows(LongRow - 4).PasteSpecial xlPasteValues
        Rows(LongRow - 5).PasteSpecial xlPasteValues
        Rows(LongRow - 6).PasteSpecial xlPasteValues
    End If
    Next
    Application.CutCopyMode = False
    End Sub
    
    

  • 답변 # 2

    둘 다 결합 및 간소화 :

    Sub FilterAndInsert
    application.screenupdating=false
    Dim lastrow As Long, rgLoop As Range, rgRed As Range
    With Sheets("Raw Data")
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        With .Range("A1:AT" & lastrow)
            .AutoFilter
            .AutoFilter Field:=16, Criteria1:="AA", Operator:=xlFilterValues
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
            Set rgRed = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            .AutoFilter
        End With
        For Each rgLoop In rgRed.Areas
            rgLoop.Resize(6).EntireRow.Insert xlShiftDown
            rgLoop.Offset(-6).Resize(6).Value = rgLoop.Value
        Next rgLoop
    End With
    application.screenupdating=true
    End Sub
    
    

  • 이전 JDK8 javatime에 대한 jackson 데이터 유형 모듈이 있습니까?
  • 다음 tfs2010 - 팀 프로젝트에서 tfs 2010 지점 - 모범 사례