2

だから私は2つのExcel文書を持っています。

(RESULT.xlsm) からデータを取得するもの。


データを挿入する別の場所 (Summary.xls)。


私が欲しいのは、強調表示された名前の横にある隣接するセルの値を、それぞれの列の下の Summary.xls に挿入することです。そこで、マクロを記録しようとしましたが、最初のレコードだけが挿入されます。

私には 2 つのリンクしか許可されていないので、すべてを 1 つの画像にまとめました: http://i50.tinypic.com/9veihl.png

注: RESULT.xlsm には複数のレコードがあり、スクリーンショットは 1 つだけを示しています。



すべてのレコード セットからデータを抽出し、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/ text-functions /column-sets-to-rows

彼らは私の問題にほぼ近い解決策を持っていたので、私はいくつかの変更を加えて完了しました：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 に答える