[[20141118152717]] 『別シートに反映させたい』(猫の手) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『別シートに反映させたい』(猫の手)

よろしくお願いします
下記の表が100ぐらいつながっています別シートに木村とつけて木村さんの分だけ飛ぶようにはできないですか
(例)1番と6番が別シート木村に反映させたいのです

初心者です お願いします

1 1111 あいうえお商事 木村 12月1日 12月2日

	K123	アイスクリーム		5個		
	K456	お菓子		3個		
2	2222 	かきくけこ商事		香取	12月1日	12月2日
	L123	ジュース		8本		
	K456	お菓子		3個		
3	3333 	さしすせそ商事		中居	12月1日	12月2日
	K123	アイスクリーム		5個		
	L123	ジュース		5本		
	K456	お菓子		3個		
4	8888 	猫 会社		稲垣	12月1日	12月2日
	A951	豆		6袋		
	B753	肉		5kg		
6	5555 	犬 会社		木村	12月1日	12月2日
	A951	豆		5袋		
	B753	肉		3kg		
7	2222 	かきくけこ商事		香取	12月1日	12月2日
	L123	ジュース		8本		
	K456	お菓子		3個		

< 使用 Excel:Excel2013、使用 OS:Windows7 >


こんにちは

初心者という事は、マクロではなくて手作業でという事でしょうか?

1行目に、行を挿入して項目名を付けます。
dummy1 dummy2 dummy3 dummy4 dummy5 dummy6 dummy7
のように

セルG2に
=IF(A2<>"",IF(D2="木村","木村",""),OFFSET(G2,-1,0,1))
と数式を入れて最下行までフィルコピーします。

オートフィルタをかけて、7列目で「木村」で絞り込んで、絞り込まれたデータ部分
の1〜6列分を他のシートにコピーするのはどうですか?

(ウッシ) 2014/11/18(火) 16:19


けっこう面倒なので、初心者を名乗るなら諦めろ、と言いたいです。
とりあえず、データのあるシートモジュールのマクロ例。

 Sub test()
    Dim cDim() As String
    Dim iDim() As Long
    Dim i As Long
    Dim j As Long
    Dim iEd As Long
    Dim iMax As Long
    Dim jMax As Long
    Dim iFlag As Long
    Dim cw As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> Me.Name Then
            Sheets(i).Delete
        End If
    Next i

    iMax = Cells(Rows.Count, "C").End(xlUp).Row

    For i = 1 To iMax
        If Cells(i, "A").Value <> "" Then
            cw = Cells(i, "C").Value
            iFlag = 0
            For j = 0 To jMax - 1
                If cw = cDim(j) Then
                    iFlag = j + 1
                End If
            Next j
            If iFlag = 0 Then
                ReDim Preserve cDim(jMax)
                ReDim Preserve iDim(jMax)
                cDim(jMax) = cw
                iDim(jMax) = 1
                jMax = jMax + 1
                iFlag = jMax
                Sheets.Add after:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = cw
            End If
            iEd = Cells(i, "A").End(xlDown).Row
            If iMax < iEd Then
                iEd = iMax + 1
            End If
            Range(Cells(i, "A"), Cells(iEd - 1, "G")).Copy Sheets(cw).Cells(iDim(iFlag - 1), "A")
            iDim(iFlag - 1) = iDim(iFlag - 1) + iEd - i
        End If
    Next i

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
(???) 2014/11/18(火) 16:37

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.