将唯一logging从一个工作簿复制到另一个主工作簿

我需要一些帮助，从一个工作簿复制到主工作簿的独特logging。

每个月我收到一个新的工作簿数据，我希望能够将新的工作簿中的所有新logging复制到一个主工作簿，这将有所有的合并logging。 有一个唯一的参考字段可用于查找来识别新logging。 除此之外，我想要执行的操作是更新主工作簿上可能位于新工作簿上的所有现有logging的3列中的值。

例

主手册

Ref Name Value 1 Value 2 Value 3 Description 123 TR 100 50 200 xxxxxxxxxxxxxxx 111 WE 90 45 400 xxxxxxxxxxxxxxx 

新的工作簿

 Ref Name Value 1 Value 2 Value 3 Description 123 TR 300 200 200 xxxxxxxxxxxxxxx 456 MA 100 500 700 xxxxxxxxxxxxxxx 

更新主工作簿

 Ref Name Value 1 Value 2 Value 3 Description 123 TR 300 200 200 xxxxxxxxxxxxxxx 111 WE 90 45 400 xxxxxxxxxxxxxxx 456 MA 100 500 700 xxxxxxxxxxxxxxx 

我将不胜感激任何帮助。 谢谢

Answer 1

我写了一个小模块，做你想做的事（甚至更多）。 我试图尽可能通用，但我不得不断言一些东西，并以某种方式限制它，否则它会快速失控（因为我认为它已经做了…）。

限制/断言如下：1.logging被认为是只在行中（根据你的例子）。 2.在更新或插入值时没有列检查。 该程序假定主工作簿和新工作簿都包含相同的列，并按照完全相同的顺序排列。 3.重复的参考值没有validation检查。 假定您在每个数据范围中指定为主键的“ref”列包含唯一值（针对该数据范围）。

除了这些假设之外，我的解决scheme还增加了灵活的参数（可选或可自动configuration – 请参阅dataRange的确定方式）以允许进行多种types的操作。

• 可选的colorAlertOption标志：允许更新或插入的条目被着色，以便更加区分（默认为true ）
• 可选的rangeWithHeaders标志：有助于确定提供的dataRange参数是否需要resize（移除标题）或不（默认为true ）
• 可选refColIndex整数：相对于dataRange – 不是整个工作表 – 列号指出包含唯一引用的列。 （默认为1 ）
• 所需dataRangeNew ， dataRangeMaster （Range）参数：分别为新数据集和主数据集的数据范围灵活表示。 您可以明确地提供它们（例如“$ A $ 1：$ D $ 10”），也可以只给出数据范围内任何位置的单个单元格。 唯一的判断是，数据范围应该与其他可能的数据隔离（通过空行或列）并且至less包含1行。

你可以像这样调用updateMasterDataRange过程：

 call updateMasterDataRange (Workbooks(2).Sheets("new").Range("a1"), Workbooks(1).Worksheets("master").Range("a1")) 

请注意完全限定的数据范围，包括工作簿和组合中的工作表。 如果不加上这些标识符，VBA将尝试将不合格的范围与ActiveWorkbook或/和ActiveWorksheet关联起来，从而产生不可预知的结果。

这里是模块的主体：

 Option Explicit Option Base 1 Public Sub updateMasterDataRange( _ ByRef dataRangeNew As Range, ByRef dataRangeMaster As Range, _ Optional refColIndexNew As Integer = 1, Optional refColIndexMaster As Integer = 1, _ Optional colorAlertOption = True, Optional rangeWithHeaders = True) ' Sanitize the supplied data ranges based on various criteria (see procedure's documentation) If sanitizeDataRange(dataRangeMaster, rangeWithHeaders) = False Then GoTo rangeError If sanitizeDataRange(dataRangeNew, rangeWithHeaders) = False Then GoTo rangeError ' Declaring counters for the final report's updated and appended records respectively Dim updatedRecords As Integer: updatedRecords = 0 Dim appendedRecords As Integer: appendedRecords = 0 ' Declaring the temporary variables which hold intermediate results during the for-loop Dim updatableMasterRefCell As Range, currentRowIndex As Integer, updatableRowMaster As Range For currentRowIndex = 1 To dataRangeNew.Rows.Count ' search the master's unique references (refColMaster range) for the current reference ' from dataRangeNew (refcolNew range) Set updatableMasterRefCell = dataRangeMaster.Columns(refColIndexMaster).Find( _ what:=dataRangeNew.Cells(currentRowIndex, refColIndexNew).Value, _ lookat:=xlWhole, searchorder:=xlByRows, searchDirection:=xlNext) ' perform a check to see if the search has returned a valid range reference in updatableMasterRefCell ' if it is found empty (the reference value in refCellNew is unique to masterDataRange) If updatableMasterRefCell Is Nothing Then Call appendRecord(dataRangeNew.Rows(currentRowIndex), dataRangeMaster, colorAlertOption) appendedRecords = appendedRecords + 1 'ReDim Preserve appendableRowIndices(appendedRecords) 'appendableRowIndices(appendedRecords) = currentRowIndex Else Set updatableRowMaster = Intersect(dataRangeMaster, updatableMasterRefCell.EntireRow) Call updateRecord(dataRangeNew.Rows(currentRowIndex), updatableRowMaster, colorAlertOption) updatedRecords = updatedRecords + 1 End If Next currentRowIndex ' output an informative dialog to the user Dim msg As String msg = _ "sheet name: " & dataRangeMaster.Parent.Name & vbCrLf & _ "records updated: " & updatedRecords & vbCrLf & _ "records appended: " & appendedRecords MsgBox msg, vbOKOnly, "--+ Update report +--" Exit Sub rangeError: MsgBox "Either range argument is too small to operate on!", vbExclamation, "Argument Error" End Sub Sub appendRecord(ByVal recordRowSource As Range, ByRef dataRangeTarget As Range, Optional ByVal colorAlertOption As Boolean = True) Dim appendedRowTarget As Range Set dataRangeTarget = dataRangeTarget.Resize(Rowsize:=dataRangeTarget.Rows.Count + 1) Set appendedRowTarget = dataRangeTarget.Rows(dataRangeTarget.Rows.Count) appendedRowTarget.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove Set appendedRowTarget = appendedRowTarget.Offset(-1, 0) ' resize datarangetarget to -1 row (because cells' shifting incurred a +1 row to dataRangeTarget) Set dataRangeTarget = dataRangeTarget.Resize(Rowsize:=dataRangeTarget.Rows.Count - 1) recordRowSource.Copy appendedRowTarget If colorAlertOption = True Then ' fills the cells of the newly appended row with lightgreen color appendedRowTarget.Interior.color = RGB(156, 244, 164) End If End Sub Sub updateRecord(ByVal recordRowSource As Range, ByVal updatableRowTarget As Range, Optional ByVal colorAlertOption As Boolean = True) recordRowSource.Copy updatableRowTarget If colorAlertOption = True Then ' fills the cells of the updated row with lightblue color updatableRowTarget.Interior.color = RGB(164, 189, 249) End If End Sub Private Function sanitizeDataRange(ByRef target As Range, ByVal rangeWithHeaders As Boolean) As Boolean ' if data range comprises only 1 cell then try to expand the range to currentRegion ' (all neighbouring cells until the selection reaches boundaries of blank rows or columns) If target.Cells.Count = 1 Then Set target = target.CurrentRegion End If ' remove headers from data ranges if flag RangeWithHeaders is true If (rangeWithHeaders) Then If (target.Rows.Count >= 2) Then Set target = target.Offset(1, 0).Resize(Rowsize:=(target.Rows.Count - 1)) Else sanitizeDataRange = False End If End If sanitizeDataRange = IIf((target.Rows.Count >= 1), True, False) End Function 

在你的例子中简单执行的结果给出了预期的结果，你可以在附图中看到。 甚至还有一个关于已完成的操作的简短报告的对话。

Answer 2

你没有太多的开始。 这个轮廓会让你开始吗？

 open all 3 workbooks for masterrow = beginrow to endrow if match in newsheet then updaterow = newrow else updaterow = masterrow end if next masterrow ' now pick up unmatched newrows for newrow = beginrow to endrow if not match in updatesheet then updaterow = newrow end if next newrow 

编辑：CodeVortex做了整个事情。 我的纲要有缺陷。

 open both workbooks appendrow = endrow of mastersheet for newrow = beginrow to endrow if match in mastersheet then update masterrow else append into appendrow appendrow = appendrow + 1 end if next newrow