excel宏有条件地复制另一个工作簿中的特定单元格

Question

今天我几乎整天（至少8个小时）都在努力寻找解决自己困境的方法，但我已无所适从。 这是场景和问题：

场景：我们有一本设备工作簿（Equipment Log.xlsx）。 该工作簿有6个工作表（Sheet1，Sheet2等）。 每张工作表的第1行有不同的“标题”，但所有工作表在相同且完全相同的列（ID，设施，建筑物，部门，部门和房间）中有几个共同的标题，并且每个工作簿中的位置都不同（到期）。

问题：我需要有一个单独的Excel工作簿（或作为最后的手段，在设备日志中添加第7个工作表），无论是打开还是用户单击特定的单元格，它都将通过原始设备日志文件，请查看每个设备的“到期”日期，如果该日期在“ Today（）”之后的30天内，则会将“ ID，设施，建筑物，部门，部门，房间和到期日”复制到活动工作表中的指定单元格中。

我对宏有一些经验，但是非常有限。 我上大学时上过JAVA-101，但是我再也没有继续过。

我对这个项目非常开放。

感谢您抽出宝贵的时间阅读，并感谢您抽出宝贵的时间回复。

Answer 1

我有点无聊，所以我想出一些办法来帮助您：

该代码将在“设备日志”工作簿中查找并循环浏览每个工作表，并根据今天的日期评估到期日期...然后，它将信息从您提到的单元格复制到运行此代码的工作簿的下一行。 您可能需要进行一些调整，但这应该是一个好的开始。

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