Excel 基于列值复制行的循环

如果

qty

列中的值大于

1

，我想复制行。应将其复制到单元格中的值的次数。然后，我想将结果复制到不同的

工作表中

，并编辑

数量

列。下面的代码执行此操作，但

qty

列的标题已更改。我该如何解决这个问题并使其更有效率

Option Explicit

Sub generateDups()
    Worksheets("Sheet2").Columns(1).ClearContents
    Worksheets("Sheet2").Columns(2).ClearContents
    Worksheets("Sheet2").Columns(3).ClearContents
    Worksheets("Sheet2").Columns(4).ClearContents

    Dim xRow As Long
    Dim inNum As Variant
    xRow = 1

    Do While (Cells(xRow, "A") <> "")
        inNum = Cells(xRow, "D")
        If ((inNum > 1) And IsNumeric(inNum)) Then
            Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
            Range(Cells(xRow + 1, "A"), Cells(xRow + inNum - 1, "D")).Select
            Selection.Insert Shift:=xlDown
            xRow = xRow + inNum - 1
        End If
        xRow = xRow + 1
    Loop

    copyAndEdit
End Sub



Sub copyAndEdit()
    Dim cValue As String
    Dim rowIndex As Integer
    Dim destRow As Integer
    Dim lastRow As Long, lastCol As Long
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet

    Set srcSheet = ThisWorkbook.Worksheets("Sheet1")
    Set destSheet = ThisWorkbook.Worksheets("Sheet2")
    destRow = 0
    
    With srcSheet
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For rowIndex = 1 To lastRow
            cValue = .Cells(rowIndex, 2).Value
            destRow = destRow + 1
            destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
            destSheet.Cells(destRow, 2) = .Cells(rowIndex, 2)
            destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
            destSheet.Cells(destRow, 4) = .Cells(rowIndex, 4) 
        Next rowIndex
    End With
        
    Set srcSheet = Nothing

    With destSheet
        destRow = 0
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For rowIndex = 1 To lastRow
            destRow = destRow + 1
            If destSheet.Cells(destRow, 4).Value > 1 Then
                destSheet.Cells(destRow, 4).Value = 1
            Else
                destSheet.Cells(destRow, 4).Value = .Cells(rowIndex, 4).Value
            End If
        Next rowIndex
        
    End With
        
    Set destSheet = Nothing
End Sub

选项显式
子代
工作表（“表2”）。列（1）。清除内容
工作表（“表2”）。列（2）。清除内容
工作表（“表2”）。第（3）列。清晰目录
工作表（“表2”）。第（4）列。清晰目录
长得一样
Dim inNum作为变体
xRow=1
Do While（单元格（X行，“A”）“”）
inNum=单元格（第X行，“D”）
如果（（inNum>1）和IsNumeric（inNum）），则
范围（单元格（X行，“A”）、单元格（X行，“D”）。复制
范围（单元格（X行+1，“A”）、单元格（X行+inNum-1，“D”）。选择
选择。插入移位：=xlDown
xRow=xRow+inNum-1
如果结束
xRow=xRow+1
环
复制编辑
端接头
子copyAndEdit（）
将C值设置为字符串
将行索引设置为整数
Dim destRow作为整数
调暗lastRow和lastCol一样长
将工作表作为工作表
将工作表设置为工作表
Set srcSheet=此工作簿。工作表（“Sheet1”）
Set destSheet=此工作簿。工作表（“Sheet2”）
destRow=0
带srcSheet
lastRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
lastCol=.Cells（1，.Columns.Count）.End（xlToLeft）.Column
对于rowIndex=1到lastRow
cValue=.Cells（行索引，2）.Value
destRow=destRow+1
destSheet.Cells（destRow，1）=.Cells（行索引，1）
destSheet.Cells（destRow，2）=.Cells（rowIndex，2）
destSheet.Cells（destRow，3）=.Cells（rowIndex，3）
destSheet.Cells（destRow，4）=.Cells（rowIndex，4）
下一行索引
以
Set srcSheet=Nothing
带床单
destRow=0
lastRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
lastCol=.Cells（1，.Columns.Count）.End（xlToLeft）.Column
对于rowIndex=1到lastRow
destRow=destRow+1
如果destSheet.Cells（destRow，4）.Value>1，则
destSheet.Cells（destRow，4）。值=1
其他的
destSheet.Cells（destRow，4）.Value=.Cells（rowIndex，4）.Value
如果结束
下一行索引
以
Set destpheet=Nothing
端接头

当前数据：

我得到的：

期望值：

---

由于您在代码的第二部分中写入了标题，因此此部分会导致问题：

destRow = 0

'.....

For rowIndex = 1 To lastRow
    destRow = destRow + 1
    If destSheet.Cells(destRow, 4).Value > 1 Then
        destSheet.Cells(destRow, 4).Value = 1

因此，您将destRow设置为0（即

destRow=0

）。在第一次迭代中，它将是第1行（

destRow=destRow+1

->

destRow=1

）。由于单元格返回的值大于1，因为它不是空的或单元格中有0，所以它将在第一行打印1（即“数量”将被覆盖）

一种方法（如果您经常使用）是这样使用

Isnumeric

（如果destSheet.Cells（destRow，4.Value>1，则替换此部分

）：

另一种跳过第一个标题的方法是忽略迭代中的第一行：

If destSheet.Cells(destRow, 4).Value > 1 And destRow <> 1 Then 'Could be >1 also

如果destSheet.Cells（destRow，4）.Value>1，那么destRow 1'也可以大于1


请注意，我还将在本部分中使用图纸参考，并声明图纸1：

Do While (srcSheet.Cells(xRow, "A") <> "")

Do While（srcSheet.Cells（xRow，“A”）“”）
请注意，行计数变量需要
Long
Excel的行数超过
Integer
所能处理的行数。您是否调试了代码以查找问题？使用F8一步一步地查看标题
Qty
被覆盖的位置，这样您就知道问题出在代码的哪一部分了。问题似乎出在
If
语句中，使用
If destSheet.Cells（destRow，4）。Value>1和destRow 1，然后按照您的建议解决了。很高兴最终解决了！快乐编码=）！
Do While (srcSheet.Cells(xRow, "A") <> "")