Question

我在Excel文件中有行项目的复制/粘贴循环，用于将这些行项目中的数据导出到基于Excel的表单中，并按行B中的值保存每个表单。我的问题是这些行项目是分开的在同一张纸上的3个不同的表中，每个表都有不同数量的要复制的行项目。此外，每个表由2个空行分隔。

我需要宏为我做什么：

从第17行开始，复制第一个表格中的所有订单项，直至找到空白行 - 此行数从1到600行不等。
跳至SecondTable并执行相同的功能。
对ThirdTable重复

忽略一些声明，因为我删除了大量代码以提高可读性。我想我需要3个单独的复制/粘贴循环才能完成这个（我这里只包括2个）并尝试使用.Find来引用第二个/第三个表的开头。宏通过第一个表正常运行，但是当它遇到空白行时不会停止，并且当它尝试根据空单元格的值保存文件时失败。我认为问题在于EndOne = .Range("B" & .Rows.Count).End(xlUp).Row下的With wsSource论证。它不计算第一个表的非空行，而是计算通过第三个表末尾的行数。

Sub CopyToForm()

Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim EndOne As Long, EndTwo As Long, EndThree As Long, i As Integer
Dim strProcessingFormPath As String
'Dim strCancel As String
'Dim strFilt As String
'Dim intFilterIndex As Integer
'Dim strDialogueFileTitle As String
Dim SecondTable As String
Dim ThirdTable As String

Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name


With wsSource
    '~~> Counts how many rows are in the Indication Tool
    EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
    If EndOne < 17 Then MsgBox "No data for transfer": Exit Sub
    For i = 17 To EndOne
        Set wbForm = Workbooks.Open(formpath) '~~> open the form
        Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
        '~~> Proceed with the copying / pasting of values
        .Range("B" & i).Copy wsForm.Range("F7:K7")
        .Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
        .Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
        .Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
        .Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
        .Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
        .Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
        .Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
        .Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
        .Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
        '.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
        '~~> Save the form using the value in cell i,B
        wbForm.SaveAs .Range("B" & i).Value & ".xls"
        wbForm.Close
        Set wbForm = Nothing
        Set wsForm = Nothing
   Next

End With

With wsSource
    SecondTable = .Range("B:B").Find("SecondTable").Row
    EndTwo = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = Second Table + 1 To EndTwo
        Set wbForm = Workbooks.Open(formpath) '~~> open the form
        Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
        '~~> Proceed with the copying / pasting of values
        .Range("B" & i).Copy wsForm.Range("F7:K7")
        .Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
        .Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
        .Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
        .Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
        .Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
        .Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
        .Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
        .Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
        .Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
        .Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
        '~~> Save the form using the cells i,B
        wbForm.SaveAs .Range("B" & i).Value & ".xls"
        wbForm.Close
        Set wbForm = Nothing
        Set wsForm = Nothing
   Next

End With

End Sub

我是否在每个表的.Find和单独的复制/粘贴循环的正确轨道上？我意识到这是一个复杂的问题，我很感激你花时间帮助我。

Answer 1

我是否在每个表的.Find和单独的复制/粘贴循环的正确轨道上？

不完全是。这些循环中的代码大致相同，因此它是子程序的一个很好的候选者。这将使您的代码更易于阅读，并且更容易维护，因为只有一个地方可以进行修改，而不是多个（想象一下，如果您需要进行10次不同的迭代，或者1000次 - 你不会可能写1000个不同的循环来做同样的事情!!）

请考虑这一点（我会观察一些明显的错误，我会纠正，但这没有经过测试）。我所做的是采取你的几个循环，并将它们合并到一个子程序中。然后我们将一些信息发送到该子例程：

，例如表开始的位置和结束的位置

Sub CopyStuff(ws as Worksheet, tblStart as Long, tblEnd as Long)

我们将发送它：wsSource，其他变量将被用于/重新使用以确定每个表的开始/结束。我删除了冗余变量（除非需要在别处重复使用，有两个变量EndOne和EndTwo是不必要的：我们可以使用更通用的变量，如tblStart和{{ 1}}我们可以为后续的表重新分配。

通过这种方式，我们以相同的方式处理多个表格更为明显。如果代码将来需要更改，我们也只有一个tblEnd循环来管理。因此，理解起来更容易，也更容易维护。

For i = ...

尝试使用Excel VBA跳过复制/粘贴循环中的空白行

1 个答案: