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

Question

我今天花了大约一整天（至少 8 小时）试图找到解决我的困境的答案，但我束手无策。这是场景和问题：

场景： 我们有一个设备工作簿（设备日志.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