时间戳

首页 > 解决方案 > Excel VBA 在空白之间复制行

excel - Excel VBA 在空白之间复制行

问题描述

我没有 VBA 的经验，我试图了解是否可以让它在 Excel 中为我运行一些东西。

我有一个装配数据集，下面有零件，系统只能将其拉入一个完整的数据集中，从顶部装配到底部（326 个装配）。

我需要一个将程序集的行复制到新工作表中的解决方案，因此我为每个程序集都有一个选项卡。

数据集示例

我拿起以下代码：

Sub Star123()
   Dim rownum As Long
   Dim colnum As Long
   Dim startrow As Long
   Dim endrow As Long
   Dim lastrow As Long
   rownum = 1
   colnum = 1
   lastrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
   With ActiveWorkbook.Worksheets("Sheet1").Range("a1:a" & lastrow)


   For rownum = 1 To lastrow
    Do
       If .Cells(rownum, 1).Value = "Start" Then
          startrow = rownum
       End If

       rownum = rownum + 1


   If (rownum > lastrow) Then Exit For

   Loop Until .Cells(rownum, 1).Value = "End"
   endrow = rownum
   rownum = rownum + 1


   Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy

   Set newSht = Sheets.Add
   Range("A1").Select
   ActiveSheet.Paste


   Next rownum
End With
End Sub

然而，这只是运行 wole 数据集，我需要了解循环如何分离成新的工作表。

标签： excel

解决方案

尝试这个。我添加了一些评论。

您的代码的主要问题只是指示的单行，它跳过了下一个“开始”。

如果每个“开始”总是紧跟在“结束”之后，则可以简化代码。

Sub Star123()

Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
Dim newSht As Worksheet

rownum = 1
colnum = 1
lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 'better than hardcoding 65336 which won't work for recent versions of xl anyway

With ActiveWorkbook.Worksheets("Sheet1").Range("a1:a" & lastrow)
    For rownum = 1 To lastrow
        Do
            If .Cells(rownum, 1).Value = "Start" Then
                startrow = rownum
            End If
            rownum = rownum + 1
            If (rownum > lastrow) Then Exit For
        Loop Until .Cells(rownum, 1).Value = "End"
        endrow = rownum
        'rownum = rownum + 1 'just needed to comment out this line as it was skipping the next Start
        Set newSht = Sheets.Add
        Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy newSht.Range("A1") 'reference sheet directly without selecting or activating
    Next rownum
End With

End Sub

推荐阅读