Excel把表中一个单元格对应多个数据汇总到一个单元格内

打开你的Excel文件,按“Alt+F11”打开VBA编辑窗口,然后在左侧空白处点击右键,“插入”,“模块”。右侧空白处粘贴下面的代码。关闭VBA窗口。

然后在单元格中使用公式:

=HEBING(在哪里查找,查找什么,返回对应的什么数据,在单元格内用什么隔开)

Function HeBing(rng1 As Range, s As String, rng2 As Range, f As String) As String
Dim Arr1, Arr2
Dim r As Long
r = rng1.End(xlDown).Row - rng1.Row + 1
Arr1 = rng1.Resize(r, 1): Arr2 = rng2.Resize(r, 1)
Dim i As Long
For i = 1 To UBound(Arr1)
    If Arr1(i, 1) = s Then
        If HeBing = "" Then HeBing = Arr2(i, 1) Else HeBing = HeBing & f & Arr2(i, 1)
    End If
Next
End Function

### 使用 VBA 宏编程实现多文件数据提取 为了满足批量获取多个 Excel 文件中指定单元格数据并将这些数据汇总一个指定的工作簿中的需求,可以采用 VBA (Visual Basic for Applications) 编写宏来完成此操作。下面是一个详细的解决方案。 #### 创建一个新的工作用于存储汇总数据 首先,在目标工作簿里创建一张新的工作专门用来保存来自其他文档的信息。这张格应该预先设计好列头以便于后续填充对应位置的内容[^1]。 ```vba Sub CreateSummarySheet() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = "汇总" ' 设置标题行 With ws.Range("A1:C1") .Value = Array("源文件", "日期", "数值") ' 假设我们要收集这三个字段 .Font.Bold = True End With End Sub ``` #### 获取目录下的所有Excel文件路径 接着定义函数 `GetFileList` 来遍历给定文件夹内的所有 `.xlsx` 或者 `.xls` 类型的文件,并返回它们完整的绝对路径列。 ```vba Function GetFileList(folderPath As String) As Collection Dim colFiles As New Collection, fileName As Variant If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" fileName = Dir(folderPath & "*.xl*") Do While Len(fileName) > 0 colFiles.Add folderPath & fileName fileName = Dir Loop Set GetFileList = colFiles End Function ``` #### 提取所需数据并记录到汇总单 最后编写主程序逻辑部分&mdash;&mdash;循环读取每一个待处理文件的相关信息,并将其追加录入之前准备好的汇总单之中。 ```vba Sub ExtractDataAndSummarize() Call CreateSummarySheet() ' 调用上面的方法新建汇总sheet Dim summaryWs As Worksheet Set summaryWs = Sheets("汇总") Dim lastRow As Long lastRow = summaryWs.Cells(summaryWs.Rows.Count, "A").End(xlUp).Row + 1 Dim filePaths As Collection Set filePaths = GetFileList("C:\Your\Target\Folder\") ' 修改为你自己的文件夹路径 For Each filePath In filePaths On Error Resume Next Workbooks.Open Filename:=filePath, ReadOnly:=True With ActiveWorkbook.Worksheets(1) Cells(lastRow, 1).Value = Mid(filePath, InStrRev(filePath, "\") + 1) ' 记录源文件名 Cells(lastRow, 2).Value = Now ' 当前时间戳可替换为实际需要采集的时间信息 Cells(lastRow, 3).FormulaR1C1 = "=['" & Left(filePath, Len(filePath) - 4) _ & "]SheetName'!$B$2" ' 这里的 SheetName 和 B2 是假设的例子,请根据实际情况调整 Application.CalculateFullRebuild Cells(lastRow, 3).Copy Cells(lastRow, 3).PasteSpecial Paste:=xlValues End With ActiveWindow.Close SaveChanges:=False lastRow = lastRow + 1 Next filePath MsgBox ("已完成!") End Sub ``` 上述代码片段展示了如何利用VBA脚本来简化日常工作中涉及大量重复劳动的任务。通过这种方式不仅可以提高工作效率还能减少人为错误的发生概率[^2]。
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

天亦可蓝

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值