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

时间:2013-10-07 22:39:07

标签: excel excel-vba copy conditional vba

我今天花了大约一整天(至少8小时)试图找到我的困境的答案,但我的斗智尽头。这是场景和问题:

方案: 我们有一个设备工作簿(Equipment Log.xlsx)。该工作簿有6个工作表(Sheet1,Sheet2,.....)。每张纸在第1行中都有不同的“标题”,但所有纸张都有几个共同的标题和完全相同的列(ID,设施,建筑,分部,部门和房间)以及每个工作簿中的位置不同(由于)。

问题: 我需要一个单独的Excel工作簿(或作为最后的手段,在设备日志中添加第7个工作表),无论是在打开时还是在用户点击特定单元格之后,它将通过原始设备日志文件,看看在每个设备的“到期”日期,如果它在“今天()”的30天内,将“ID,设施,建筑,部门,部门,房间和到期”复制到活动工作表中的指定单元格。

我对宏有一些经验,但它非常有限。我在大学里学过JAVA-101,但我从来没有继续学过。

我对这个项目非常开放。

感谢您花时间阅读,感谢+++花时间回应。

1 个答案:

答案 0 :(得分: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