英文:
How to get unique combinations of two columns from multiple excel files?
问题
我有一个文件夹中有多个Excel表格。它们具有“Department”和“Grade”列。我想要从所有文件中获取这两列的唯一组合,并将其保存到不同的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,
I should get:
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
' Set the path to the folder containing the files
filePath = "C:\Users\myuser\Documents\sample excel files\"
' Get the first file in the folder
fileName = Dir(filePath & "*.xlsx")
' Loop through each file in the folder
Do While fileName <> ""
' Open the file
Set wbSource = Workbooks.Open(filePath & fileName)
Set wsSource = wbSource.Sheets(1) ' Assuming the data is in the first sheet
' Get the last row in the active workbook
lastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
' Loop through each row in the source worksheet
For Each sourceRow In wsSource.Range("A2:B" & wsSource.Cells(Rows.Count, "A").End(xlUp).Row)
' Concatenate values from columns A and B in the source workbook
searchValue = sourceRow.Cells(1).Value & sourceRow.Cells(2).Value
' Find the concatenated value in the active workbook
Set foundRange = ActiveWorkbook.Sheets(1).Range("A2:B" & lastRow).Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)
' 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, "A").Value = sourceRow.Cells(1).Value
ActiveWorkbook.Sheets(1).Cells(lastRow, "B").Value = sourceRow.Cells(2).Value
End If
Next sourceRow
' Close the source workbook
wbSource.Close SaveChanges:=False
' Get the next file in the folder
fileName = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox "Copy complete."
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论