Question

我刚开始使用Excel的VBA代码，如果这看起来很基本，那么道歉。我想做以下......

检查名为“Index”的工作表的J列（J5到J500）是否存在值“Y”。这是我的条件。然后我只想将满足条件的 C列到I Only 复制到现有工作表和不同位置的单元格，即如果复制索引值C3到I3我想将它们粘贴到我所在的活动纸张的A5到G5，比如Sheet2。

如果索引表有变化，我希望自动复制数据，如果可能的话。如果将新数据添加到索引，该怎么办？

经过大量搜索，我发现this。从这个问题我稍微改变了代码以满足我的要求，这将把符合条件的整行复制到我运行宏的工作表中，但我很难过如何仅选择某些列。

Sub CopyRowsAcross() 

Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Index") 
Dim ws2 As Worksheet: Set ws2 = ActiveSheet 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
If ws1.Cells(i, 2) = "Y" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 

End Sub

感谢任何帮助

约翰

编辑：我创建了一个模型，它位于https://docs.google.com/file/d/0B0RttRif9NI0TGl0N1BZQWZfaFk/edit?usp=sharing

复制时不需要A和B列 - 或者是J列 - 这就是我用来检查条件的内容。

到目前为止，感谢您的帮助。

Answer 1

借用了一些旧代码。在这里你要检查使用的最后一行，如果你知道你只想转到500，你可以只使用整数：

Sub try2()



  Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string.
  Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
  Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble
  Dim Ary1 As Range
  Dim ary2 As Range


   x = 5
   Y = "Y" 'for the sake of argument
         'For i = 2 To ws1.Range("B65536").End(xlUp).Row   This is if you are looking for the last row in MsOf2003 or earlier.  If you know that you are only looking to row 500, then hard code the intiger.
   For i = 2 To 500:
        'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J)
         If ws1.Cells(i, 10) = Y Then
            ws1.Activate
            Set Ary1 = Range(Cells(i, 3), Cells(i, 9))
            ws2.Activate
            Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it
            ary2.Value = Ary1.Value
            x = x + 1
         End If
   Next i
  End Sub

Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string. Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index") Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get you into trouble Dim Ary1 As Range Dim ary2 As Range x = 5 Y = "Y" 'for the sake of argument 'For i = 2 To ws1.Range("B65536").End(xlUp).Row This is if you are looking for the last row in MsOf2003 or earlier. If you know that you are only looking to row 500, then hard code the intiger. For i = 2 To 500: 'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J) If ws1.Cells(i, 10) = Y Then ws1.Activate Set Ary1 = Range(Cells(i, 3), Cells(i, 9)) ws2.Activate Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it ary2.Value = Ary1.Value x = x + 1 End If Next i End Sub

我在不在编译器上的手机上写这个，因此可能存在语法错误，这应该被视为伪VBA代码。我可以稍后查看你是否可以使用它。如果你不想让它们被覆盖，你必须注意你放东西的位置。

Answer 2

这是更优雅的解决方案，更类似于我原来的帖子。唯一的区别是Cells引用符合正确的工作表。



Sub try3()
Dim i, x As Long
Dim Y as String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble

 x = 5
 Y = "Y"
 For i = 2 To 500:
    If ws1.Cells(i, 10) = Y Then
       Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value
      x = x + 1
    End If
 Next i
End Sub

Sub try3() Dim i, x As Long Dim Y as String Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index") Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get you into trouble x = 5 Y = "Y" For i = 2 To 500: If ws1.Cells(i, 10) = Y Then Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value x = x + 1 End If Next i End Sub

VBA代码，用于将符合条件的行中的选定列复制到另一个工作表

2 个答案: