[[20170607150510]]　『複数のシートから選択したものを別シートに移行し』（ぺい）　ページの最後に飛ぶ

『複数のシートから選択したものを別シートに移行したい』（ぺい）

シート１

　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｆ　　　　Ｇ

１　【材料Ａ】

２　＊＊＊１　　　　　　　ヶ

３　＊＊＊２　　　　　　　ヶ

４　＊＊＊３　　　　　　　ヶ

５　＊＊＊４　　　　　　　ヶ

６　【材料Ｂ】

７　＊＊＊１０　　　　　　ヶ

このようなシートがあり（上図参照）

種類を【　　】で区切っており、例えばＢ２セルに１０と記入したらシート２の方に

（下図参照）シート１のＡ２・Ｂ２・Ｃ２セルのﾃﾞｰﾀとＡ１セルの【材料Ａ】も反映される

シート２

　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｆ　　　　Ｇ

１　【材料Ａ】

２　＊＊＊１　１０　　　　ヶ

３

４

５

６

７

そこから続けてシート１のＢ３セルに５と

記入したら（下図参照）シート２の方に続けて反映される

※【材料Ａ】はそのまま継続、【材料Ａ】の項目が無くなれば自動で消去

シート２

　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｆ　　　　Ｇ

１　【材料Ａ】

２　＊＊＊１　１０　　　　ヶ

３　＊＊＊２　５　　　　　ヶ

４

５

６

７

この次にシート１のＢ７セルに２と記入したら

Ａ３・Ｂ３・Ｃ３セルのﾃﾞｰﾀとＢ６セル【材料Ｂ】シート２の方で下記のように

反映される

　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｆ　　　　Ｇ

１　【材料Ａ】

２　＊＊＊１　１０　　　　ヶ

３　＊＊＊２　５　　　　　ヶ

４　【材料Ｂ】

５　＊＊＊７　１０　　　　ヶ

６

７

この状態でシート１のＢ４セルに３と入力した場合は

下図のように【材料Ｂ】と＊＊＊７　１０　　　　ヶが１セルずれて反映される

シート２

　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｆ　　　　Ｇ

１　【材料Ａ】

２　＊＊＊１　１０　　　　ヶ

３　＊＊＊２　５　　　　　ヶ

４　＊＊＊３　３　　　　　ヶ

５　【材料Ｂ】

６　＊＊＊７　１０　　　　ヶ

７

※【材料○】はＡ・Ｂだけではありまあせん複数あります。

エクセル学校内で検索してみたのですが見つけられませんでした。

乱筆悪文のためお見苦しい点も多いかと存じますが宜しくお願い致します。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

何をどうしたいのか、さっぱり理解できません。また、貴方がどういう処理を考えていて、何に困っているのかも判らず、答えようがないです…。
やりたい事だけ書いてあって、この通りに動くコードを作ってくれ、という丸投げ依頼にも見えてしまい、本気で解読する気にもなりませんでした。すいません。
（???） 2017/06/07(水) 17:45

Private Sub Worksheet_Change(ByVal Target As Range)
'Sheet1のシートモジュール

    Dim dt() As Boolean, r As Range, c As Range, i As Long, flg As Boolean
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    Sheets("Sheet2").Cells.ClearContents
    Set r = Sheets("Sheet2").Range("A1:C1")
    ReDim dt(Range("A" & Rows.Count).End(xlUp).Row)
    For Each c In Intersect(UsedRange, Columns("A"))
        If Trim(c.Offset(, 2).Value) = "" Then
            If Not flg Then dt(temprow) = False
            temprow = c.Row
            dt(c.Row) = True
            flg = False
        End If
        If Trim(c.Offset(, 1).Value) <> "" Then dt(c.Row) = True: flg = True
    Next c
    If Not flg Then dt(temprow) = False
    For i = 0 To WorksheetFunction.CountA(Range("A:A"))
        If dt(i) = True Then
            r.Value = Range("A" & i).Resize(, 3).Value
            Set r = r.Offset(1)
        End If
    Next i
End Sub
（mm） 2017/06/07(水) 18:27

コメント返信：

[ 一覧(最新更新順) ]

[[20170607150510]] 『複数のシートから選択したものを別シートに移行し』（ぺい） ページの最後に飛ぶ

[[20170607150510]]　『複数のシートから選択したものを別シートに移行し』（ぺい）　ページの最後に飛ぶ