[[20200430221919]]　『ひとつ上のセルをコピーして違うところのセルに貼』（こまった）　ページの最後に飛ぶ

『ひとつ上のセルをコピーして違うところのセルに貼り付けるマクロ』（こまった）

いつもお世話になってます
少しわかりにくいのですが

例
A B
４／３０　←　コピーしたいセル
１個
２個
・
・
・
・
２０個
とあって

個数の横に日付を貼り付けて
完成例

A B
４／３０　
１個　　４／３０
２個　　４／３０
・
・
・
・
２０個　４／３０
みたいにしたいのですがどうすれば良いですか
わかりにくいのですがよろしくお願いします

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

 ・1個というセルが選択されていて、
 ・20個というセルが最終行で、その下のセルは空白行である
 として、こんなコードはどうですか？

 Sub test()
     Dim rng As Range

     Set rng = Range(Selection, Selection.End(xlDown))
     rng.Offset(0, 1).Value = Selection.Offset(-1).Value
 End Sub
 前提が異なることに伴う微修正は、そちらでどうぞ。

（γ） 2020/04/30(木) 23:03

遅れましたがありがとうございます
（こまった） 2020/05/05(火) 11:20

ではなくて
１個というセルの上のセルをコピーして
１個の右のせるに貼り付けたいのです
わかりにくいのですがすいません
（こまった） 2020/05/05(火) 21:45

 >１個というセルの上のセルをコピーして

 Sub Test()
    Dim myR As Variant

    myR = Application.Match("1個", Columns(1), 0)
    If IsError(myR) Then
        MsgBox """1個"" が見つかりません!", vbExclamation
    Else
        Range("A" & myR, Cells(Rows.Count, "A").End(xlUp)).Offset(, 1).Value = _
            Range("A" & myR - 1).Value
    End If
 End Sub

（ピンク） 2020/05/06(水) 09:11

ありがとうございます
誠に申し訳ないのですが
A B
４／３０　←　コピーしたいセル
１個
２個
・
・
・
・
２０個
５／１　
１個
２個
・
・
・
・
２０個
みたいな場合
４／３０　←　コピーしたいセル
１個　　４／３０
２個　　４／３０
・
・
・
・
２０個　４／３０
５／１　
１個　　５／１
２個　　５／１
・
・
・
・
２０個　５／１
みたいにしたいのですがどうしたらいいでしょうか
色々すいません

（こまった） 2020/05/06(水) 16:25

 >みたいにしたいのですがどうしたらいいでしょうか

 Sub Test()
    Dim fRng As Range, fAddress As String

    Set fRng = ActiveSheet.Columns(1).Find("1個", LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchByte:=True)
    If fRng Is Nothing Then
        MsgBox """1個"" が見つかりません!", vbExclamation
        Exit Sub
    End If
    fAddress = fRng.Address
    Do
        fRng.Offset(, 1).Resize(20).Value = fRng.Offset(-1).Value
        Set fRng = ActiveSheet.Columns(1).FindNext(fRng)
    Loop While fAddress <> fRng.Address
 End Sub

（ピンク） 2020/05/06(水) 17:03

ありがとうございます
でも必ずある状態で実行する場合ifはいりませんよね?
（こまった） 2020/05/06(水) 17:12

 >でも必ずある状態で実行する場合ifはいりませんよね?

 はい!!、要りません!!

（ピンク） 2020/05/06(水) 18:36

わかりましたやってみてわからなかったらまた連絡します

（こまった） 2020/05/06(水) 18:54

やってみました
基本的にできました
追加で質問しますが　もし
１個

２個
みたいに間に数行開いてる場合
１個

２個
の個の行にだけ日付を貼り付けるようなことはできますか
（こまった） 2020/05/06(水) 19:49

 >個の行にだけ日付を貼り付けるようなことはできますか

 Sub Test2()
    Dim c As Range, myDate As Date

    For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
        If IsDate(c.Value) Then
            myDate = c.Value
        ElseIf c.Value Like "*個" Then
            c.Offset(, 1).Value = myDate
        End If
    Next c
 End Sub

（ピンク） 2020/05/06(水) 20:23

ありがとうございます
質問だらけですいません
仮に日付以外の値でも可能でしょうか

（こまった） 2020/05/06(水) 20:27

 >仮に日付以外の値でも可能でしょうか

 Sub Test3()
    Dim c As Range, 項目 As String

    For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
        If c.Value Like "*個" Then
            c.Offset(, 1).Value = 項目
        ElseIf c.Value <> "" Then
            項目 = c.Value
        End If
    Next c
 End Sub

（ピンク） 2020/05/06(水) 20:46

ありがとうございます
（こまった） 2020/05/06(水) 20:51

 日付、日付以外の混合の場合

 Sub Test4()
    Dim c As Range, 項目 As Range

    For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
        If c.Value Like "*個" Then
            項目.Copy c.Offset(, 1)
        ElseIf c.Value <> "" Then
            Set 項目 = c
        End If
    Next c
 End Sub

 キリがないから、これで終わり。ヾ(^_^) byebye！！

（ピンク） 2020/05/06(水) 20:55

ありがとうございます
仮に２つ上の場合どの部分を改良すればいいでしょうか
（こまった） 2020/05/11(月) 19:56

そのままで動きますよ。
コード内容をよく理解してください。
（γ） 2020/05/12(火) 08:04

よくわかりませんすいません教えて下さい
（こまった） 2020/05/12(火) 20:04

コメント返信：

[ 一覧(最新更新順) ]

[[20200430221919]] 『ひとつ上のセルをコピーして違うところのセルに貼』（こまった） ページの最後に飛ぶ

[[20200430221919]]　『ひとつ上のセルをコピーして違うところのセルに貼』（こまった）　ページの最後に飛ぶ