vba excel宏有条件地从另一个工作簿复制特定单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19236033/
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 conditionally copy specific cells from another workbook
提问by LudivousKain
I've spent just about the whole day today (8 hours at least) trying to find an answer to my dilemma, but I'm at my wits' end. Here's the scenario and issue:
我今天几乎花了一整天（至少 8 小时）试图找到解决我的困境的答案，但我已经无能为力了。这是场景和问题：
Scenario: We have one equipment workbook (Equipment Log.xlsx). That workbook has 6 worksheets (Sheet1, Sheet2,.....). Each sheet has different "headings" in row 1, but all sheets have several headings in common and in the exact same columns (ID, Facility, Building, Division, Department, and Room) along with one who's position is different in each workbook (Due).
场景：我们有一个设备工作簿（Equipment Log.xlsx）。该工作簿有 6 个工作表（Sheet1、Sheet2.....）。每张工作表在第 1 行都有不同的“标题”，但所有工作表都有几个共同的标题，并且在完全相同的列（ID、设施、建筑、部门、部门和房间）中，并且每个工作簿中的位置都不同（到期的）。
Issue: I need to have a separate Excel workbook (or as a LAST resort, add a 7th worksheet to the equipment log) which, either upon opening or once the user clicks on a specific cell, will then go through the original equipment log file, look at each equipment's "Due" date, and if it falls within 30 days from "Today()" will copy "ID, Facility, Building, Division, Department, Room, and Due" to designated cells in the active worksheet.
问题：我需要一个单独的 Excel 工作簿（或者作为最后的手段，将第 7 个工作表添加到设备日志中），在打开或用户单击特定单元格后，将查看原始设备日志文件，查看每个设备的“到期”日期，如果它在“今天（）”的 30 天内，则将“ID、设施、建筑物、部门、部门、房间和到期”复制到活动工作表中的指定单元格。
I have SOME experience with macros, but it's VERY limited. I took JAVA-101 in college, but I never continued more than that.
我对宏有一些经验，但它非常有限。我在大学里学过 JAVA-101，但我从来没有继续过。
I'm VERY open-minded with this project.
我对这个项目非常开放。
Thanks for taking the time to read, and THANKS+++ for taking the time to respond.
感谢您花时间阅读，感谢您花时间回复。
回答by stobin
I'm a bit bored, so I figured I'd whip up something to help you out:
我有点无聊，所以我想我会拿出一些东西来帮助你：
This code will look in the Equipment Log workbook and loop through each worksheet, evaluating the due date against today's date... It will then copy the info from the cells you mentioned into the next row of whichever workbook you run this code from. You will likely have to make some adjustments, but it should be a good start.
此代码将查看设备日志工作簿并遍历每个工作表，根据今天的日期评估截止日期......然后它将您提到的单元格中的信息复制到您运行此代码的任何工作簿的下一行。您可能需要进行一些调整，但这应该是一个好的开始。
Sub equipLog()
Dim eqWb As Workbook
Dim sh1 As Worksheet
Dim due, ID, fac, bldg, div, dept, room
Dim dateDue As Date
Dim rArr As Variant
Dim ws As Worksheet
Set sh1 = ThisWorkbook.Sheets("Sheet1")
Set eqWb = Workbooks.Open("C:\Code3\Equipment Log.xlsx") ' change this to your equipment sheet path
wsNums = eqWb.Worksheets.Count
For Each ws In eqWb.Worksheets
ws.Activate
Set due = Cells.Find("Due")
Set ID = Cells.Find("ID")
Set room = Cells.Find("Room")
lrEq = Range("A" & Rows.Count).End(xlUp).Row
For i = (due.Row + 1) To lrEq
dateDue = Cells(i, due.Column)
dd = DateDiff("d", Date, dateDue)
If Abs(dd) < 30 Then
' I'm assuming that the cells are all located in a row in the order you mentioned
rArr = Range(Cells(ID.Row + 1, ID.Column), Cells(room.Row + 1, room.Column))
x = 1
lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
For Each c In rArr
sh1.Cells(lr + 1, x) = c
x = x + 1
Next c
sh1.Cells(lr + 1, x + 1) = dateDue
End If
Next i
Next ws
End Sub
