[[20101008103009]]　『抽出したCSVファイルで必要な値を別シートで抽出ａx（nobbyy）　ページの最後に飛ぶ

『抽出したCSVファイルで必要な値を別シートで抽出したい』（nobbyy）

 会計システムから担当者売上をCSV出力したものを毎日手作業で必要な項目だけを残す作業をしています。
 あまりにも、項目と人数が多いので、シート2に抽出したCSVファイルを貼り付け、必要な項目をシート1で表示する方法を教えてください。
 CSVファイルは
 A列　　　　B列　　　　C列　　　D列　　　E列　　　F列　　　G列　　I列
 担当者A　売上件数　返品件数　構成比　売上金額　値引額　純売上　平均単価
 りんご　　　1　　　　　0　　　　50％　　100　　　0　　　　100　　100
 みかん　　　1　　　　　0　　　　50％　　50　　　　0　　　　50　　50
 合計　　　　2　　　　　0　　　　100％　　150　　　0　　　　150　　75
 担当者B
 みかん　　　2　　　　　0　　　　40％　　90　　　　0　　　　90　　　45
 りんご　　　2　　　　　0　　　　40％　　200　　　 0　　　　200　　100
 パイン　　　1　　　　　0　　　　20％　　200　　　 0　　　　200　　200
 合計　　　　5　　　　　0　　　　100％　 490　　　 0　　　　490　　115
 これを、シート２に張り付けてシート１に
 A列　　　　　B列　　　　　　C列　　　　　D列　　　　E列
 担当者名　合計売上件数　　合計売上額　合計純売上　平均単価
 担当者A　　　　2　　　　　　150　　　　　150　　　　　75
 というように、抽出したいです。毎日担当者により販売する品目数が違う為、いつも同じ行に同じ項目があるとは限りません。
 また、社員の休日・出勤日によっても行数が変わります。列の項目は変わりません。「＝シート２！C5」と関数を使っても、日によって行数が変わり抽出できなく
 困っています。どうぞご教授お願い致します。

 関数でやってみました。。

 Sheet1の
 A2=IF(COUNTIF(Sheet2!$A$1:$A$10,"担当者"&"*")>=ROW(A1),INDEX(Sheet2!$A$1:$A$10,SMALL(INDEX((LEFT(Sheet2!$A$1:$A$10,3)<>"担当者")*10^7+ROW($A$1:$A$10),),ROW(A1))),"")
 B2=IF(A2<>"",INDEX(Sheet2!$B$1:$B$10,SMALL(INDEX((Sheet2!$A$1:$A$10<>"合計")*10^7+ROW($A$1:$A$10),),ROW(A1))),"")
 C2=IF(A2<>"",INDEX(Sheet2!$E$1:$E$10,SMALL(INDEX((Sheet2!$A$1:$A$10<>"合計")*10^7+ROW($A$1:$A$10),),ROW(A1))),"")
 D2=IF(A2<>"",INDEX(Sheet2!$G$1:$G$10,SMALL(INDEX((Sheet2!$A$1:$A$10<>"合計")*10^7+ROW($A$1:$A$10),),ROW(A1))),"")
 E2=IF(A2<>"",INDEX(Sheet2!$I$1:$I$10,SMALL(INDEX((Sheet2!$A$1:$A$10<>"合計")*10^7+ROW($A$1:$A$10),),ROW(A1))),"")
 A2:E2を選択して、下方にコピペ。。
 (kei)

 こんにちは
 Sheet2 の1行目は
 担当者A　売上件数　返品件数　構成比　売上金額　値引額　純売上　平均単価
 のように担当者名と項目名が同じ行に入っているのですね？

 Sub test()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim k   As String
    Dim d   As Range
    Dim i   As Long
    Dim r   As Range

    'Sheet1 の1行目には項目名が入っているとする。

    Set sh1 = Worksheets("Sheet1"): Set sh2 = Worksheets("Sheet2")
    Application.ScreenUpdating = False
    With sh2
        k = .Range("B1").Value
        .Range("B1").ClearContents
        On Error Resume Next
        Set d = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) _
                    .Offset(, 1).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not d Is Nothing Then
            For i = 1 To d.Areas.Count
                With d.Areas(i)
                    Set r = d.Areas(i).Cells(.Cells.Count)
                    sh1.Range("A" & sh1.Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value _
                        = Array(.Cells(1).Offset(-1, -1).Value, _
                                r.Value, _
                                r.Offset(, 3).Value, _
                                r.Offset(, 5).Value, _
                                r.Offset(, 6).Value)

                End With
            Next
        End If
        .Range("B1").Value = k
    End With
    Application.ScreenUpdating = True
End Sub
（ウッシ）

nobbyyです。
ありがとう御座います。早速試してみます。

コメント返信：

[ 一覧(最新更新順) ]

[[20101008103009]] 『抽出したCSVファイルで必要な値を別シートで抽出ａx（nobbyy） ページの最後に飛ぶ

[[20101008103009]]　『抽出したCSVファイルで必要な値を別シートで抽出ａx（nobbyy）　ページの最後に飛ぶ