2

所以我有两个excel文件。

一个从 (RESULT.xlsm) 中获取数据。


另一个将数据插入（Summary.xls）。


我想要的是突出显示名称旁边的相邻单元格值插入到相应列下的 Summary.xls 中。所以我尝试录制一个宏，但发生的只是第一条记录被插入。

由于我只允许使用两个链接，所以我将它们全部放在一张图片中：http: //i50.tinypic.com/9veihl.png

注意：RESULT.xlsm 中有多条记录，屏幕截图仅显示一条。



我想了解如何从所有记录集中提取数据并插入到 Summary.xlsx 中



这是录制的宏代码：

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 文件

请帮忙。

非常感谢：）

4

1 回答 1

1

所以我查看了很多资源并尝试按照@Tim Williams 告诉我的内容，偶然发现了这个页面（最后一部分）：https ://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/文本函数/列集到行

他们的解决方案几乎接近我的问题，所以我做了一些修改，我完成了：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 列标题不匹配，我暂时修复了它，因为我环顾四周，找不到自动修剪所有空间的方法整个专栏。

就是这样了：）

于 2013-02-08T15:01:26.773 回答