Question

我目前正在尝试创建一个脚本，该脚本在运行时会查看单元格A5中的所有唯一值，直到每日工作表中使用的最后一行。对于这些值中的每一个，它们必须从A3到最后一行的主表中查找。

如果主工作表中已存在唯一值，则必须将新值从B＆amp; Row复制到每日工作表中的H＆amp; Row上的现有值在B＆amp; Row到H＆amp; Row的主表中。如果唯一值不存在，则必须将其放在下一个可用行以及从B＆amp; Row到H＆amp; Row的相应数据。

下面是我目前正在尝试执行的代码，但它无法正常运行有问题的部分是“'对于每日班次报告中的所有停机时间，查找它们是否为新的或主表中存在的更新 “;

ev

非常感谢任何帮助。

Answer 1

解决，

请参阅下面的代码以获得解决方案;

Sub SaveWorkbook()
Dim C As Range
Dim lastC As Long
Dim lastRow As Long
Dim eRow As Long
Dim w1 As Workbook
Dim w2 As Workbook
Dim rng As Range
Dim v As Variant
Dim Fname As String
Application.ScreenUpdating = False
Fname = Worksheets("Cover").Range("B5").Text & ".xlsm"
'Clear workers on shift
'-------------------------------------------------------------------------
ActiveWorkbook.SaveAs Filename:="C:\Users\sreilly\Documents\test\" & Worksheets("Cover").Range("B5").Text & ".xlsm"
Sheets("Cover").Activate
lastC = Cells(Rows.Count, "C").End(xlUp).Row + 16
With Range("B13:F50")
  .ClearContents
End With
'Open Mastersheet and define empty row in Downtimes
'-------------------------------------------------------------------------
Application.Workbooks.Open ("C:\Users\sreilly\Documents\test\ShiftReportMaster.xlsx")
Set w1 = Workbooks(Fname)
Set w2 = Workbooks("ShiftReportMaster.xlsx")
lastRow = w1.Worksheets("Downtime").Cells(Rows.Count, "A").End(xlUp).Row
eRow = w2.Worksheets("Downtimes").Cells(Rows.Count, "A").End(xlUp).Row
'For all Downtimes in Daily Shift Report find if they are new or update existing in mastersheet
'----------------------------------------------------------------------------------------------
For n = 5 To lastRow
    v = Application.Match(w1.Worksheets("Downtime").Cells(n, 1), w2.Worksheets("Downtimes").Columns("A"), 0)
        If IsNumeric(v) Then
            w1.Activate
            w1.Worksheets("Downtime").Activate '.Range(Cells(n, 1), Cells(n, 15)).Select
            w1.Worksheets("Downtime").Range(Cells(n, 2), Cells(n, 15)).Copy
            w2.Activate
            w2.Worksheets("Downtimes").Range(Cells(v, 2), Cells(v, 15)).PasteSpecial xlPasteValuesAndNumberFormats
        Else
            eRow = eRow + 1
            w1.Activate
            w1.Worksheets("Downtime").Activate '.Range(Cells(n, 1), Cells(n, 15)).Select
            w1.Worksheets("Downtime").Range(Cells(n, 1), Cells(n, 15)).Copy
            w2.Activate
            w2.Worksheets("Downtimes").Range(Cells(eRow, 1), Cells(eRow, 15)).PasteSpecial xlPasteValuesAndNumberFormats
        End If

Next n
'Save and close mastersheet with changes and clear all information to make new template for next shift
'------------------------------------------------------------------------------------------------------
Workbooks("ShiftReportMaster.xlsx").Close savechanges:=True
Sheets("downtime").Range("A1:O100").ClearContents 'clear downtimes
Sheets("downtime").Range("Q5:T100").ClearContents 'clear delays
Sheets("workorder").Range("A8:BZ100").ClearContents 'clear workorder information
Sheets("Time confirmations").Range("A2:L100").ClearContents 'clear time confirmation information
Sheets("cover").Range("E5:E7").ClearContents 'clear Crew, Supervisor and Coordinator

Sheets("Cover").Activate
If Range("E4").Value = "DS" Then
    Range("E4").Value = "NS"
Else
    Range("E4").Value = "DS"
    Range("F3").Value = Range("F3").Value + 1
End If

'If next shifts report doesnt exist in folder already, create it other wise skip this step
'------------------------------------------------------------------------------------------
If Dir("C:\Users\sreilly\Documents\test\" & Worksheets("Cover").Range("B5").Text & ".xlsm") = "" Then

ActiveWorkbook.Close savechanges:=True, Filename:="C:\Users\sreilly\Documents\test\" & Worksheets("Cover").Range("B5").Text & ".xlsm", RouteWorkbook:=False
End If

Application.ScreenUpdating = True

End Sub

使用更新的值和每日信息中的新值更新主表

1 个答案: