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

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

如果唯一值已存在于主工作表中，则必须将每日工作表中的新值从B&Row复制到H&Row，而不是将主工作表中的现有值从B&Row复制到H&Row。如果唯一值不存在，则必须将其与B&row到H&row的相应数据一起放在下一个可用行

下面是我目前正在尝试执行的代码，但无法执行。有问题的部分是“每日轮班报告中的所有停机时间，查找它们是否是新的或母版中现有的更新””

非常感谢您的帮助。

已解决

请参阅下面的代码了解解决方案

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

---

我目前正在尝试创建一个脚本

如果你要提供你所尝试的内容，这将对社区有很大帮助。这个过程中有几个步骤-如果你能概括出任务的哪个特定部分给你带来了问题，这将有助于你的问题。基本上，我正在试图找出最好的方法来解决我的问题仍然认为自己是一个业余爱好者。我一直在使用Range.DalyTabl中的每一个值寻找方法。A5：AalStand并在MealStudio中找到它。A5：AlastRow。对于找到的每个匹配项，我希望它将dailysheet.BRowMatch:HRowmatch复制到MasterSheet上BRowMatch:HRowmatch。对于不匹配的值，我希望将dailysheet.ARow:HRow值复制到Mastersheet中的下一个空行

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