本文最后更新于8 天前,如有版本迭代或环境切变,可告知邮箱到xianghy_m@sina.com指正修改。
飞书文档
假设:现在将n个人汇总上来的区域销售数据合并,会存在哪些要另行处理的非理想情况?
检查文件是否存在:
Sub TestFilePath()
Dim folderPath As String
Dim fileName As String
folderPath = "D:\下载\演示\示例\"
fileName = Dir(folderPath & "*.xlsx*")
If fileName = "" Then
MsgBox "没有找到任何 Excel 文件!"
Else
MsgBox "找到的第一个文件名: " & fileName
End If
End Sub
合并文件路径下的工作簿:
Sub ImportSheetsFromFiles()
Dim folderPath As String
Dim fileName As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim destWorkbook As Workbook
' 设置文件路径
folderPath = "D:\下载\演示\示例\"
' 检查文件夹路径是否存在
If Dir(folderPath, vbDirectory) = "" Then
MsgBox "文件夹路径无效: " & folderPath, vbExclamation
Exit Sub
End If
Set destWorkbook = ThisWorkbook
fileName = Dir(folderPath & "*.xlsx*")
Do While fileName <> ""
Set wbSource = Workbooks.Open(folderPath & fileName)
Set wsSource = wbSource.Sheets(1)
wsSource.Copy After:=destWorkbook.Sheets(destWorkbook.Sheets.Count)
wbSource.Close SaveChanges:=False
fileName = Dir
Loop
MsgBox "所有工作表已成功导入!", vbInformation
End Sub
非常规
合并来自不同sheet的数据源
Sub MergeColumnsMultipleRanges()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim outputWs As Worksheet
Dim i As Long, col As Long
Dim value1 As Variant, value2 As Variant, value3 As Variant
Dim mergedValue As Variant
Set ws1 = ThisWorkbook.Sheets(1) ' 第1个Sheet
Set ws2 = ThisWorkbook.Sheets(2) ' 第2个Sheet
Set ws3 = ThisWorkbook.Sheets(3) ' 第3个Sheet
' 创建一个新工作表存放结果
On Error Resume Next
Set outputWs = ThisWorkbook.Sheets("合并结果")
If outputWs Is Nothing Then
Set outputWs = ThisWorkbook.Sheets.Add
outputWs.Name = "合并结果"
End If
On Error GoTo 0
outputWs.Cells.Clear
' 遍历C列到H列(列数分别是3到8)
For col = 2 To 8
' 确保遍历200行
For i = 1 To 200
' 从第3个Sheet开始读取
value3 = ws3.Cells(i, col).Value
' 从第2个Sheet读取
value2 = ws2.Cells(i, col).Value
' 从第1个Sheet读取
value1 = ws1.Cells(i, col).Value
' 合并逻辑:优先级为Sheet2 > Sheet3 > Sheet1
If value2 <> "" Then
mergedValue = value2
ElseIf value3 <> "" Then
mergedValue = value3
ElseIf value1 <> "" Then
mergedValue = value1
Else
mergedValue = "" ' 如果都为空,保留空值
End If
' 写入结果到新表
outputWs.Cells(i, col).Value = mergedValue
Next i
Next col
MsgBox "合并完成,结果存放在'合并结果'工作表中!"
End Sub