将结果列复制并粘贴到另一个电子表格中答案

【问题标题】：copy and paste resultant column into another spreadsheet将结果列复制并粘贴到另一个电子表格中
【发布时间】：2012-03-04 02:37:17
【问题描述】：

我想知道是否有人可以帮助我缩短代码，因为我担心添加其他代码后可能需要很长时间才能运行。我想要做的将在下面解释：

我想复制说 test2（请注意，间距意味着变量在自己的行和列上）

test1 1 2 1
test2 2 1 4
test3 1 1 1

复制后我会将其粘贴到其他工作表上。

假设，我有另一组结果说

test2 2 1 4
test3 3 9 8
test5 1 1 1

我想复制 test2，但我的 VBA 编码无法复制，因为它仍然假定 test2 在第二行。

最后一种情况是，如果 test2 不可用，它将继续复制其余结果并将其粘贴到其他工作表。

我已经进行了一些编码，请运行并帮助我解决这个问题。谢谢！

Sub Macro1()

 iMaxRow = 6 ' or whatever the max is.
    'Don't make too large because this will slow down your code.

    ' Loop through columns and rows
    For iCol = 1 To 1 ' or however many columns you have
        For iRow = 1 To 1

        With Worksheets("Sheet3").Cells(iRow, iCol)
            ' Check that cell is not empty.
            If .Value = "Bin1" Then
                Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin2" Then
                Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin3" Then
               Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin4" Then
                Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin5" Then
                Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin6" Then
                Range("A1:G1").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A1").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If



        End With

    Next iRow
    Next iCol

For iCol1 = 1 To 1 ' or however many columns you have
        For iRow1 = 1 To 2

        With Worksheets("Sheet3").Cells(iRow1, iCol1)
            ' Check that cell is not empty.

                If .Value = "Bin2" Then
                Range("A2:G2").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A2").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin3" Then
                Range("A2:G2").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A2").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin4" Then
               Range("A2:G2").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A2").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin5" Then
               Range("A2:G2").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A2").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin6" Then
                Range("A2:G2").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A2").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If

        End With

    Next iRow1
    Next iCol1

For iCol2 = 1 To 1 ' or however many columns you have
        For iRow2 = 1 To 3

        With Worksheets("Sheet3").Cells(iRow2, iCol2)
            ' Check that cell is not empty.

                If .Value = "Bin3" Then
                Range("A3:G3").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A3").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin4" Then
               Range("A3:G3").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A3").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin5" Then
                Range("A3:G3").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A3").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin6" Then
                Range("A3:G3").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A3").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If

        End With

    Next iRow2
    Next iCol2

For iCol3 = 1 To 1 ' or however many columns you have
        For iRow3 = 1 To 4

        With Worksheets("Sheet3").Cells(iRow3, iCol3)
            ' Check that cell is not empty.

                If .Value = "Bin4" Then
                Range("A4:G4").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A4").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin5" Then
                Range("A4:G4").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A4").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin6" Then
                Range("A4:G4").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A4").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If

        End With

    Next iRow3
    Next iCol3

For iCol4 = 1 To 1 ' or however many columns you have
        For iRow4 = 1 To 5

        With Worksheets("Sheet3").Cells(iRow4, iCol4)
            ' Check that cell is not empty.

                If .Value = "Bin5" Then
                Range("A5:G5").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A5").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            ElseIf .Value = "Bin6" Then
                Range("A5:G5").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A5").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If

        End With

    Next iRow4
    Next iCol4

For iCol5 = 1 To 1 ' or however many columns you have
        For iRow5 = 1 To 6

        With Worksheets("Sheet3").Cells(iRow5, iCol5)
            ' Check that cell is not empty.

                If .Value = "Bin6" Then
                 Range("A6:G6").Select
                Selection.Copy
                Sheets("sheet4").Select
                Range("A6").Select
                ActiveSheet.Paste
                Sheets("sheet3").Select
            End If

        End With

    Next iRow5
    Next iCol5
Sheets("Sheet4").Select
Range("A1").Select

End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

我正在努力确定您的代码的作用。下面我指定了一些简化和其他必要的改进，但一旦我们清理了灌木丛，可能会有更多。

更改 1

请使用Option Explicit 并声明您的变量。这样可以避免将拼写错误的变量视为新的隐式声明。

更改 2

请使用Application.ScreenUpdating = False。这避免了在宏完成其任务时重新绘制屏幕。由于工作表之间的所有切换，这对您的代码来说是必不可少的。它对我的代码不太重要，因为我不切换工作表。

变化3

替换：

With Sheets("Sheet3")
  :
  Range("A1:G1").Select
  Selection.Copy
  Sheets("sheet4").Select
  Range("A1").Select
  ActiveSheet.Paste
  Sheets("sheet3").Select
  :
End With

作者：

With Sheets("Sheet3")
  :
  .Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
  :
End With

这样可以避免换页，这是最大的时间浪费。

更改 4

对于每个 If-ElseIf-ElseIf-EndIf，您都执行相同的复制。所以：

If .Value = "Bin1" Or .Value = "Bin2" Or .Value = "Bin3" _
   .Value = "Bin4" Or .Value = "Bin5"                   Then

会有同样的效果。

到目前为止的总结

我相信以下内容与您的第一个循环完全相同：

Option Explicit
Sub Macro1()
  Dim iCol As Long
  Dim iRow As Long
  Dim ValueCell as String

  With Sheets("Sheet3")
    For iCol = 1 To 1
      For iRow = 1 To 1
        ValueCell = .Cells(iRow, iCol).Value
        If ValueCell = "Bin1" Or ValueCell = "Bin2" Or ValueCell = "Bin3" Or _
           ValueCell = "Bin4" Or ValueCell = "Bin5"                   Then
         .Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
        End If
      Next
    Next
  End With

End Sub

可能的进一步变化

循环真的是独立的吗？在我看来，您似乎可以将它们合并成一个循环。

为响应 cmets 的交换而添加了新部分

考虑问题中的代码：

您有六个双循环。
在任何情况下，外循环都是For iCol = 1 to 1。也就是说，您只检查“A”列，尽管您暗示如果代码更快，您将检查更多列。
内循环是For iRow = 1 to №。 № 在第一个循环中为 1，在第二个循环中为 2，在第六个循环中为 6。您再次暗示，如果代码更快，您将检查更多行。
每个循环的操作取决于 № 的值。

显示动作№效果的表格：

Value
 of №   Cells examined   Values checked for   Range moved
   1    A1               "Bin1" ... "Bin6"    A1:G1
   2    A1, A2           "Bin2" ... "Bin6"    A2:G2
   3    A1, A2, A3       "Bin3" ... "Bin6"    A3:G3
   4    A1, A2, ... A4   "Bin4" ... "Bin6"    A4:G4
   5    A1, A2, ... A5   "Bin5", "Bin6"       A5:G5
   6    A1, A2, ... A6   "Bin6"               A6:G6

也就是说，在双循环 № 中，检查单元格 A1 到 A№，检查值“Bin№”到“Bin6”，如果找到，则将 Sheets("Sheet3").Range("A№:G№") 复制到 Sheets("Sheet4").Range("A№)。

在您的文本和示例数据中，您指的是“text2”而不是“Bin2”。我不明白你想做什么。下面，我将介绍更多的 VBA，它们可以帮助您创建所需的代码。如果没有，您将不得不在问题中添加一个新部分，用英语解释您正在尝试做什么。

新语法 1

考虑：

For iRow = 1 to 6
    :
  .Range("A6:G6").Copy Destination:=Worksheets("Sheet4").Range("A6")
    :
Next

"A6:G6" 和 "A6" 是您可以在运行时构建的字符串。

现在考虑：

For iRow = 1 to iRowMax
    :
  .Range("A" & iRowMax & ":G" & iRowMax)).Copy _
                         Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
    :
Next

根据 iRowMax 的值给出：

iRow    Statement    
  1     .Range("A1:G1")).Copy Destination:=Worksheets("Sheet4").Range("A1")
  2     .Range("A2:G2")).Copy Destination:=Worksheets("Sheet4").Range("A2")
  3     .Range("A3:G3")).Copy Destination:=Worksheets("Sheet4").Range("A3")

新语法 2

在运行时更改范围的另一种方法是替换：

.Range(string)

与

.Range(.Cells(RowTop,ColLeft),.Cells(RowBottom,ColRight))

使用此语法，您可以轻松指定所需大小的矩形。

新语法 3

考虑：

For i = 1 to 5
  If this(i) = that Then
    Do something fixed
    Exit For
  End If
Next
' Exit For statement jumps to here

在这个循环中，我正在测试五个值。如果有任何匹配，我会做一些事情。如果我在第一个值上得到匹配，我不需要检查其他值。 Exit For 允许我跳出 For-Loop。如果有嵌套的 For-Loops，Exit For 只退出内层循环

新语法 4

"Bin1"、"Bin2"等也可以在运行时创建。

iRowMax = 4
For iRow = 1 to iRowMax
  For iBin = iRowMax to 6
    If ValueCell = "Bin" & iBin Then
      ' Move Range
      Exit For
    End If 
  Next
  ' Exit For statement jumps to here
Next

当 iRow = 4 时，内部 For-Loop 将 iBin 设置为 4、5 和 6。这会将 "Bin" & iBin 设置为 "Bin4"、"Bin5" 和 "Bin6"。

所以：

  For BinNum = iRowMax to 6
    If ValueCell = "Bin" & BinNum Then
      ' Move Range
      Exit For
    End If 
  Next

等同于：

  If ValueCell = "Bin4" Or ValueCell = "Bin5" Or ValueCell = "Bin6" Then
    ' Move Range
  End If

这个新代码比原来的更复杂，更难理解，但它可能是你所需要的。

总结

我已经向您展示了根据 iRow 的值改变所发生情况的不同方法。我希望其中之一能让你建立你想要的例程。

我尚未对其进行测试，但我认为这与原始代码中的所有六个循环相同：

Option Explicit
Sub Macro1()
  Dim iBin as Long
  Dim iCol As Long
  Dim iRow As Long
  Dim iRowMax as Long
  Dim ValueCell as String

  Application.ScreenUpdating = False

  With Sheets("Sheet3")
    For iRowMax = 1 to 6
      For iCol = 1 To 1     ' This could be replaced by iCol = 1 at the top
        For iRow = 1 To iRowMax
          ValueCell = .Cells(iRow, iCol).Value
          For iBin = iRowMax to 6
            If ValueCell = "Bin" & iBin Then
              .Range("A" & iRowMax & ":G" & iRowMax)).Copy _
                      Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
            End If
          Next iBin
        Next iRow
     Next iCol
  End With
End Sub

注意：仅删除所有 Select 语句会使此代码比您的代码更快。其他更改使其更小并且速度稍慢，因为我有两个额外的 For 循环，并且我在运行时构建字符串。

【讨论】：

顺便说一句，我试过在一个循环中做。它没有显示我想要的结果。
此外，我尝试了另一个循环，使用 If ValueCell = "Bin2" Or ValueCell = "Bin3" Or _ ValueCell = "Bin4" Or ValueCell = "Bin5" 然后我尝试使用其他变量例如测试，似乎 if 语句失败。它仍然显示在 excel 文件中
请注意我没有看到你的数据。例如，您问题中的数据不包括“Bin1”或“Bin5”。所以我无法诊断问题。也许这些循环看起来好像它们可以组合起来。你知道如何使用调试器吗？停在如果。 ValueCell 的值是你所期望的吗？如果您保留原始循环，但按照我简化第一个循环的方式对其进行简化，那会得到您想要的结果吗？
嗨托尼，很抱歉变量的使用。 Bin1 = test1 等等...我只是想使用不同的名称。我以前没有使用过调试器，但我尝试过用你的简化版本做同样的循环。它确实奏效了。谢谢！ :) 但是对于我在上一条评论中提出的问题，它实际上复制了另一个不在 if 循环内的变量名称，例如，一个名为实验的名称。换句话说 Bin1 1 2 3 Bin3 1 2 3 Experiment 1 2 3 当它没有在 if 循环中声明时，它实际上复制了实验。我希望你明白我想说什么。
随时回来。我大部分时间都在查看 Stack Exchange，看起来我的升级已经完成，没有任何问题。