Question

我试图在条件满足时复制一行，我搜索并构建了这段代码。

我希望我的代码要做的是，如果C列的单元格中的值的长度超过15次重复1次，并且如果超过30次重复2次，则复制一行 ，它会在它下面创建一个副本然后继续到下一行，依此类推，直到结束。

这是我的初始代码：

Dim ia, iaLastrow As Long

    iaLastrow = ShtData.Range("A" & Rows.Count).End(xlUp).Row

    For ia = 2 To iaLastrow

        If Len(ShtData.Cells(ia, 3).Value) > 15 Then

            ShtData.Cells(ia, 1).EntireRow.Offset(1).Insert
            ShtData.Cells(ia, 1).EntireRow.Copy Destination:=ShtData.Cells(ia, 1).Offset(1)

        End If

    Next ia

我认为我的代码遗漏了一些东西，它会创建一行但是在第一次出现之后它会重复，直到数据结束。

修改

这就是我所做的，一个有效的代码。

 Dim ia, iaLastrow As Long

    iaLastrow = ShtData.Range("A" & Rows.Count).End(xlUp).Row

    For ia = iaLastrow To 2 Step -1

        If Len(ShtData.Cells(ia, 3).Value) > 15 And Len(ShtData.Cells(ia, 3).Value) < 30 Then

            ShtData.Cells(ia, 1).EntireRow.Offset(1).Insert
            ShtData.Cells(ia, 1).EntireRow.Copy Destination:=ShtData.Cells(ia, 1).Offset(1)

        ElseIf Len(ShtData.Cells(ia, 3).Value) > 30 Then

            ShtData.Cells(ia, 1).EntireRow.Offset(1).Insert
            ShtData.Cells(ia, 1).EntireRow.Copy Destination:=ShtData.Cells(ia, 1).Offset(1)

            ShtData.Cells(ia, 1).EntireRow.Offset(2).Insert
            ShtData.Cells(ia, 1).EntireRow.Copy Destination:=ShtData.Cells(ia, 1).Offset(2)

        End If

    Next ia

非常感谢

Answer 1

您需要撤消for循环

Dim ia, iaLastrow As Long

ibLastrow = ShtData.Range("A" & Rows.Count).End(xlUp).Row

For ia = iaLastrow To 2 step -1

    If Len(ShtData.Cells(ia, 3).Value) > 15 Then

        ShtData.Cells(ia, 1).EntireRow.Offset(1).Insert
        ShtData.Cells(ia, 1).EntireRow.Copy Destination:=ShtData.Cells(ia, 1).Offset(1)

    End If

Next ia

满足条件时复制整行

1 个答案: