excel - 在excel中合并两个文件中的数据并进行一些计算

Question

该项目包括根据来自 2 个不同表(或 Excel 文件)的值在新表中添加行。
有 3 个文件，由 :

引用:文件内容不会改变

数据:文件内容会一直变化

结果:文件的内容是基于我下面的请求的引用和日期的组合。这是我需要的。
我创建了 3 个文件，所有这些文件都带有一些值，以帮助您理解，分别称为 Example_Reference、Example_Data 和 Example_Result。
要做什么:

第一步:
写一个新行(在新文件/表中)并准确复制引用文件第一行的所有单元格。
第二步:
我们获取引用文件的单元格(A 列)的内容(与点 1 相同的行)，如果至少有一个单元格(A 列)完全相同，我们会在数据文件中查看:
一个。如果不是:什么都不做，继续引用文件的下一行(这样做直到引用行的行尾(不是 Excel 的结尾，但是当里面没有更多的行时))
湾。如果是 :
一世。查看 A 列(数据文件)中有多少行具有相同值(文本)，创建(在结果文件中)行数等于相同值的数量，并从数据文件中复制所有数据和行(对于当然是相同的 A 列)。
ii.在第一行(在第 1 点创建)中修改单元格(R 列)，并在第 2.b 点添加列 R 的不同值。每行带有特定的“;”如示例所示。 (T1；T2；T3……如果 T1 T2 和 T3 在线)。
iii.对于主行(产品被写入，如在引用文件和行中)，在第 N 列，它应该是下面所有数字的总和(0、3 或 😎 对于所有子行(变体)。
3. 如果 sum = 0，在 K 列写 FALSE。如果 sum 不为 0，在 K 列写 TRUE。
C。这样做直到我们完成阅读引用的所有行
以下是示例三个文件的图像:

引用

资料

结果

到目前为止，我已经完成了 第一步如下:

    Dim cel As Range
    Dim oFoundRng As Range

Range("A1").End(xlUp).Select ' looking for first empty cell on result sheet

With Workbooks("Example_Reference").Worksheets("Feuil1")
With .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
    For Each cel In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty cells
    
.Range(cel.Address).EntireRow.Copy Workbooks("result").Worksheets("feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
    
    Next
End With
End With

现在我需要获取引用文件的单元格(A 列)的内容(与点 1 相同的行)，如果至少一个单元格(A 列)完全相同，我们将在数据文件中查看。
你们能帮忙吗？
我会随着我的进展更新我的问题......

Answer 1

在这里，如果按您的预期工作，请告诉我:)
只需使用您的名称或路径设置工作簿变量。
潜艇已准备好与已打开的三个工作区一起工作，但如果
您希望宏打开 wbks，只需在开头添加 workbooks.open 方法。

Sub ProcessData()
    
    'Workbook ans worksheet declaration
    Dim referenceWbk As Workbook
    Set referenceWbk = Workbooks("Reference.xlsx")
    Dim dataWbk As Workbook
    Set dataWbk = Workbooks("Data.xlsx")
    Dim exampleWbk As Workbook
    Set exampleWbk = Workbooks("Example.xlsm")
       
    Dim referenceWsh As Worksheet
    Set referenceWsh = referenceWbk.Sheets(1)
    Dim dataWsh As Worksheet
    Set dataWsh = dataWbk.Sheets(1)
    Dim exampleWsh As Worksheet
    Set exampleWsh = exampleWbk.Sheets(1)
    
    'Loop reference workbook
    Dim exampleLastRow As Long: exampleLastRow = 1
    
    Dim i As Long
    For i = 1 To referenceWsh.Range("A" & referenceWsh.Rows.Count).End(xlUp).Row
        referenceWsh.Range("A" & i).EntireRow.Copy
        exampleWsh.Range("A" & exampleLastRow).PasteSpecial xlPasteValues
        
        'loop data wsh
        Dim coicidenceCount As Long: coicidenceCount = 0
        'Delete header in column N, R and K
        exampleWsh.Range("N" & exampleLastRow).Value = ""
        exampleWsh.Range("R" & exampleLastRow).Value = ""
        exampleWsh.Range("K" & exampleLastRow).Value = ""
        
        Dim j As Long
        For j = 1 To dataWsh.Range("A" & dataWsh.Rows.Count).End(xlUp).Row
            If dataWsh.Range("A" & j).Value = exampleWsh.Range("A" & exampleLastRow).Value Then
                coicidenceCount = coicidenceCount + 1
                exampleWsh.Range("A" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("A" & j).Value
                exampleWsh.Range("R" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("B" & j).Value
                exampleWsh.Range("N" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("C" & j).Value
                exampleWsh.Range("B" & exampleLastRow + coicidenceCount).Value = "Variant"
                
                'add value to R header (plus ';')
                exampleWsh.Range("R" & exampleLastRow).Value = exampleWsh.Range("R" & exampleLastRow).Value & dataWsh.Range("B" & j).Value & ";"
                'add value to N header
                exampleWsh.Range("N" & exampleLastRow).Value = exampleWsh.Range("N" & exampleLastRow).Value + dataWsh.Range("C" & j).Value
            End If
        Next j
        
            'add value to K header
            If exampleWsh.Range("N" & exampleLastRow).Value > 0 Then
                exampleWsh.Range("K" & exampleLastRow).Value = True
            Else
                exampleWsh.Range("K" & exampleLastRow).Value = False
            End If
            
            'delete last ';' from R header
            If exampleWsh.Range("R" & exampleLastRow).Value <> "" Then
            exampleWsh.Range("R" & exampleLastRow).Value = Left(exampleWsh.Range("R" & exampleLastRow).Value, Len(exampleWsh.Range("R" & exampleLastRow).Value) - 1)
            End If
            
            exampleLastRow = exampleWsh.Range("A" & exampleWsh.Rows.Count).End(xlUp).Row + 1
                
    Next i
    End Sub