如何从多个Excel文件中获取两列的唯一组合?

huangapple go评论54阅读模式
英文:

How to get unique combinations of two columns from multiple excel files?

问题

我有一个文件夹中有多个Excel表格。它们具有“Department”和“Grade”列。我想要从所有文件中获取这两列的唯一组合,并将其保存到不同的Excel工作簿中。
例如,如果一个文件中有这个:

如何从多个Excel文件中获取两列的唯一组合?

我应该得到:

如何从多个Excel文件中获取两列的唯一组合?

类似地,它应该只从其余文件中获取这两列的唯一组合。因此,如果其余文件中包含“IT”和“P01”,那么它应该被忽略,因为已经存在。

英文:

I have multiple excel sheets in a folder. They have columns "Department" and "Grade". I want to get the unique combinations of these two columns from all the files to a different excel workbook.
For eg. if I have this in one file,

如何从多个Excel文件中获取两列的唯一组合?

I should get:

如何从多个Excel文件中获取两列的唯一组合?

And similarly, it should take only unique combinations of these two columns only from the remaining files. So if any of the remaining files contains "IT" and "P01", then it should be ignored as it is already there.

答案1

得分: 1

这将复制每个Excel文件的值到活动工作簿中。

假设单元格的值位于每个文件的列A和B,从第2行开始,请相应地修改路径、源工作表名称和目标工作表名称。

Sub MergeDataFromFiles()
    Dim filePath As String
    Dim fileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim sourceRow As Range
    Dim searchValue As String
    Dim foundRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' 设置包含文件的文件夹路径
    filePath = "C:\Users\myuser\Documents\sample excel files\"

    ' 获取文件夹中的第一个文件
    fileName = Dir(filePath & "*.xlsx")

    ' 循环遍历文件夹中的每个文件
    Do While fileName <> ""
        ' 打开文件
        Set wbSource = Workbooks.Open(filePath & fileName)
        Set wsSource = wbSource.Sheets(1) ' 假设数据在第一个工作表中

        ' 获取活动工作簿中的最后一行
        lastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

        ' 循环遍历源工作表中的每一行
        For Each sourceRow In wsSource.Range("A2:B" & wsSource.Cells(Rows.Count, "A").End(xlUp).Row)
            ' 在源工作簿中连接列A和B的值
            searchValue = sourceRow.Cells(1).Value & sourceRow.Cells(2).Value

            ' 在活动工作簿中查找连接后的值
            Set foundRange = ActiveWorkbook.Sheets(1).Range("A2:B" & lastRow).Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)

            ' 如果未找到,则将值复制到活动工作簿中的下一个空行
            If foundRange Is Nothing Then
                lastRow = lastRow + 1
                ActiveWorkbook.Sheets(1).Cells(lastRow, "A").Value = sourceRow.Cells(1).Value
                ActiveWorkbook.Sheets(1).Cells(lastRow, "B").Value = sourceRow.Cells(2).Value
            End If
        Next sourceRow

        ' 关闭源工作簿
        wbSource.Close SaveChanges:=False

        ' 获取文件夹中的下一个文件
        fileName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "复制完成。"
End Sub
英文:

this will copy the values from each excel file to the activeworkbook

assuming the cell values are in column A and B of each files starting at row 2, modify path,source sheet name and destination sheet name accordingly

Sub MergeDataFromFiles()
    Dim filePath As String
    Dim fileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim sourceRow As Range
    Dim searchValue As String
    Dim foundRange As Range
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    &#39; Set the path to the folder containing the files
    filePath = &quot;C:\Users\myuser\Documents\sample excel files\&quot;
    
    &#39; Get the first file in the folder
    fileName = Dir(filePath &amp; &quot;*.xlsx&quot;)
    
    &#39; Loop through each file in the folder
    Do While fileName &lt;&gt; &quot;&quot;
        &#39; Open the file
        Set wbSource = Workbooks.Open(filePath &amp; fileName)
        Set wsSource = wbSource.Sheets(1) &#39; Assuming the data is in the first sheet
        
        &#39; Get the last row in the active workbook
        lastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row
        
        &#39; Loop through each row in the source worksheet
        For Each sourceRow In wsSource.Range(&quot;A2:B&quot; &amp; wsSource.Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row)
            &#39; Concatenate values from columns A and B in the source workbook
            searchValue = sourceRow.Cells(1).Value &amp; sourceRow.Cells(2).Value
            
            &#39; Find the concatenated value in the active workbook
            Set foundRange = ActiveWorkbook.Sheets(1).Range(&quot;A2:B&quot; &amp; lastRow).Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            &#39; If not found, copy the values to the next empty row in the active workbook
            If foundRange Is Nothing Then
                lastRow = lastRow + 1
                ActiveWorkbook.Sheets(1).Cells(lastRow, &quot;A&quot;).Value = sourceRow.Cells(1).Value
                ActiveWorkbook.Sheets(1).Cells(lastRow, &quot;B&quot;).Value = sourceRow.Cells(2).Value
            End If
        Next sourceRow
        
        &#39; Close the source workbook
        wbSource.Close SaveChanges:=False
        
        &#39; Get the next file in the folder
        fileName = Dir
    Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox &quot;Copy complete.&quot;

End Sub

huangapple
  • 本文由 发表于 2023年5月28日 20:46:02
  • 转载请务必保留本文链接:https://go.coder-hub.com/76351573.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定