Excel – 根据某些文本将相邻的数据值复制到另一个表单，直到表单结束
所以我有两个Excel文件。
一个从（RESULT.xlsm）获取数据。
另一个插入数据（Summary.xls）。
我想要的是在高亮的名字旁边的相邻单元格值插入到相应列下的Summary.xls中。 所以我试图录制一个macros，但是只发生了第一个插入的logging。
由于只有两个链接，我把它放在一张照片： http : //i50.tinypic.com/9veihl.png
注意：RESULT.xlsm中有多条logging，屏幕截图只显示一条logging。
我想帮助我如何从所有logging集中提取数据并在Summary.xlsx中插入
这里是logging的macros代码：
Sub Summ() Workbooks.Open Filename:="Summary.xlsx" Windows.Arrange ArrangeStyle:=xlVertical Windows("RESULT.xlsm").Activate Cells.Find(What:="Air System Name", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range("B10").Select Selection.Copy Windows("Summary.xlsx").Activate Range("A5").Select ActiveSheet.Paste Windows("RESULT.xlsm").Activate Cells.Find(What:="Floor Area", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range("B14").Select Application.CutCopyMode = False Selection.Copy Windows("Summary.xlsx").Activate Range("B5").Select ActiveSheet.Paste Windows("RESULT.xlsm").Activate Cells.Find(What:="Total coil load", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range("B27").Select Application.CutCopyMode = False Selection.Copy Windows("Summary.xlsx").Activate Range("C5").Select ActiveSheet.Paste Windows("RESULT.xlsm").Activate Cells.Find(What:="Sensible coil load", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False, SearchFormat:=False).Activate Range("B28").Select Application.CutCopyMode = False Selection.Copy Windows("Summary.xlsx").Activate Range("D5").Select ActiveSheet.Paste Windows("RESULT.xlsm").Activate Cells.Find(What:="Max block L/s", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range("B30").Select Application.CutCopyMode = False Selection.Copy Windows("Summary.xlsx").Activate Range("E5").Select ActiveSheet.Paste Range("A6").Select End Sub 我还附加了mediafire的excel文件：
Excel文件
请帮忙。
非常感谢：）
所以我抬头看了很多资源，试着按照@Tim Williams告诉我的方式，偶然发现了这个页面（最后一部分）： https ： //sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/文本function/列集到的行
他们有一个解决scheme几乎接近我的问题，所以我做了一些修改，我完成了：D
注意：这是在相同的文件，不同的工作表。
它的代码：
Dim LR As Long, NR As Long, Rw As Long Dim wsData As Worksheet, wsOUT As Worksheet Dim HdrCol As Range, Hdr As String, strRESET As String Set wsData = Sheets("Sheet1") 'source data Set wsOUT = Sheets("Sheet2") 'output sheet strRESET = " Air System Name " 'this value will cause the record row to increment LR = wsData.Range("A" & Rows.Count).End(xlUp).Row 'end of incoming data Set HdrCol = wsOUT.Range("1:1").Find(strRESET, _ LookIn:=xlValues, LookAt:=xlWhole) 'find the reset category column If HdrCol Is Nothing Then MsgBox "The key string '" & strRESET & _ "' could not be found on the output sheet." Exit Sub End If NR = wsOUT.Cells(Rows.Count, HdrCol.Column) _ .End(xlUp).Row 'current output end of data Set HdrCol = Nothing On Error Resume Next For Rw = 1 To LR Hdr = wsData.Range("A" & Rw).Value If (Hdr = " Air System Name ") Then NR = NR + 1 End If If Hdr <> "" Then Set HdrCol = wsOUT.Range("1:1").Find(Hdr, _ LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not HdrCol Is Nothing Then wsOUT.Cells(NR, HdrCol.Column).Value _ = wsData.Range("B" & Rw).Value Set HdrCol = Nothing End If End If Next Rw
唯一的小问题是空间。 在我的excel文档中，我的报告有拖尾和前导空格，这与我的sheet2列标题不匹配，我暂时修正了它，因为我环顾四周，找不到自动修剪所有空间的方法整个专栏。
就是这样了：）