Question

是否有人可以提供一些VBA代码，以方便以下请求？

我想复制六行并将它们粘贴到同一行的新工作表中。我有数百行，因此请求代码。它需要将前六行复制到一行，接下来的六行复制到第二行等。每个要复制的行都有九个单元格，如下例所示。

ColA            |ColB           |ColC|ColD|ColE|ColF|ColG|ColH|ColI
Separatecombined|Smoothedremoved|1.00|1.00|99  |90  |95  |98  |accuracy

非常感谢。

安迪

Answer 1

此站点的存在是为了让程序员能够帮助其他程序员发展他们的技能。有时在答案中提供了重要的代码片段，但这不是免费的编码站点。

执行您需要的操作的宏非常简单，我根本不相信您知道任何VBA。通常我会通过告诉你如何编写你寻求的宏来回答这样的问题。但是，您的要求非常简单，编码比提供说明更容易。如果要使用宏，则必须学习VBA。学习基础知识不会花费很长时间，花费的时间会快速回报。搜索＆＃34; VBA Excel教程＆＃34;。有很多可供选择。尝试一些并完成符合您学习风格的那个。我更喜欢书。我访问了一个大型图书馆并查看了所有Excel VBA引物。然后我买了我喜欢的那个。

第一项任务是找到源工作表中最后使用的行。我使用的方法通常是最方便的。但是，有几种查找最后一行或列的方法，并且在每种情况下都不起作用。我选择的方法可能无法处理您的数据。此answer of mine包含一个宏FindFinal，它使用各种方法并在失败时显示。如有必要，这将帮助您选择替代方案。

然后，您需要嵌套for循环来移动数据。

以下宏是您要求的，但我不确定它是您想要的宏。如果我有你的要求，我希望源行1（列标题）重复六次，然后将行2复制到最后。我给你的任务是创建一个内循环的副本来实现这种重复。如果有必要，请回答问题，但我相信强迫您做出此修订将有助于您理解我的代码并帮助您发展自己的技能。

祝你好运，欢迎来到编程的乐趣。

Option Explicit
Sub MergeRows()

   Dim ColDestCrnt As Long
   Dim RowDestCrnt As Long
   Dim RowSrcCrnt As Long
   Dim RowSrcLast As Long
   Dim RowWithinGroupNum As Long
   Dim WshtDest As Worksheet

   Application.ScreenUpdating = False

   Set WshtDest = Worksheets("Destination")

   With Worksheets("Source")

     ' Find last used row of worksheet.  This assumes column "A"
     ' contains a value in every used row.
     RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row

     RowDestCrnt = 1

     ' Loop for each set of six rows.  Unless the source worksheet
     ' contains a multiple of six rows, the last set will involve the
     ' copying of empty rows.  I decided it was less effort to copy
     ' these empty rows than to include code to not copy them
     For RowSrcCrnt = 1 To RowSrcLast Step 6

       ' Loop for each row within a set
       For RowWithinGroupNum = 0 To 5

         ' Calculate the start column in the destination worksheet
         ColDestCrnt = (RowWithinGroupNum) * 6 + 1

         ' Copy all six cells from the current source row to the six cells
         ' starting at the appropriate column in the destination row
         .Range(.Cells(RowSrcCrnt + RowWithinGroupNum, 1), _
                .Cells(RowSrcCrnt + RowWithinGroupNum, 6)).Copy _
                      Destination:=WshtDest.Cells(RowDestCrnt, ColDestCrnt)

       Next RowWithinGroupNum

       ' Step the destination row ready for the next set
       RowDestCrnt = RowDestCrnt + 1

     Next RowSrcCrnt

   End With

End Sub

从Excel工作表复制多行并粘贴到新Excel工作表上的同一行

1 个答案: