vba Excel宏可根据单元格值将行中的选择单元格从一张工作表复制到另一张工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21662567/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Macro to copy select cells from a row from one sheet to another based upon a cell value
提问by encom
I'm trying to do the following with an excel macro. When a date is entered into a cell on sheet 1 I want to take specific cells from that row and copy them to a new row on sheet 2. Here is an example.
我正在尝试使用 excel 宏执行以下操作。当日期输入到工作表 1 上的单元格中时，我想从该行中取出特定单元格并将它们复制到工作表 2 上的新行。这是一个示例。
This would be sheet 1.
这将是工作表 1。
A B C D E
proj1 mary started - fiber
proj2 Hyman complete 2/7/2014 fiber
proj3 kim started - cat6
proj2 phil complete 2/9/2014 fiber
Sheet 2 should then look like this since two of them have dates and I only want to bring over specifically the cells from row A,C and D.
工作表 2 应该看起来像这样，因为其中两个有日期，我只想从 A、C 和 D 行中取出特定的单元格。
A B C
proj2 complete 2/7/2014
proj2 complete 2/9/2014
With the following code I found I'm able to bring over an entire row based on a word value in a cell but not just the specific ones I want and of course I want it to trigger based on a date being entered not the words "reply" or "response". Any help would be appreciated.
使用以下代码，我发现我可以根据单元格中的单词值而不只是我想要的特定值来引入整行，当然我希望它根据输入的日期而不是单词来触发“回复”或“回复”。任何帮助，将不胜感激。
Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("reply,response", ",")
For Each cell In Sheets("sheet1").Range("D:D")
If (Len(cell.Value) = 0) Then Exit For
For i = 0 To UBound(aTokens)
If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("sheet1").Rows(cell.Row).Copy Sheets("sheet2").Rows(iMatches)
End If
Next
Next
End Sub
回答by Alex P
This may help. It needs to be placed in the Worksheet_Changesection.
这可能会有所帮助。它需要放置在Worksheet_Change节中。
This assumes your data is in Columns A:Ein Sheet1and you want to copy data over to Sheet2once you have entered a date.
这假设您的数据位于 ColumnsA:E中，Sheet1并且您希望在Sheet2输入日期后将数据复制到其中。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextRow As Long
If Not Intersect(Target, Range("D:D")) Is Nothing Then
If VBA.IsDate(Target) Then
With Worksheets("Sheet2")
nextRow = IIf(VBA.IsEmpty(.Range("A1048576").End(xlUp)), 1, .Range("A1048576").End(xlUp).Row + 1)
.Range("A" & nextRow) = Target.Offset(0, -3)
.Range("B" & nextRow) = Target.Offset(0, -1)
.Range("C" & nextRow) = Target
End With
End If
End If
End Sub
