[[20180313195241]]　『最終行に入力』（チーター）　ページの最後に飛ぶ

『最終行に入力』（チーター）

A1に型番を入力　B1に日付けを入力するフォーマットがあり、それぞれ入力後
A1で入力したものはA行10～20、B1で入力したものはB行10～20の名前ボックスで指定した範囲に入力できるマクロはできますでしょうか。その時、A行とB行にはすでに入力された型番、日付けがあり、行の最終行に追加されるマクロをご教授ください。イメージはA1とB1に入力⇒マクロのボタンをクリックするとA行とB行の最終行に追加されるといったものです。よろしくお願いします。

＜使用 Excel：Excel2008(Mac)、使用 OS：Windows7 ＞

すみません。EXCEL2010のWINDOWS7 です。
（チーター） 2018/03/13(火) 20:09

       A              B
1    JK123      3月6日        
2
3
4
5
6
7
8
9
10 AB525    2月8日
11 BB454    2月9日
12                             ←A12にJK123   B12に3月6日 と
13                                行の最後に追加したい です
14
15
.
.
.

（チーター） 2018/03/13(火) 20:59

おはようございます。　　＾＾

＞A1で入力したものはA行10～20、B1で入力したものは
＞B行10～20の名前ボックスで指定した範囲に入力できるマクロ

追加した情報はいづれも20行を越えると表示しない。。。消す。。。
って事でしょうか。
あと、どの箇所でお困りなのか具体的に
エラー、とか、作成されたコード等、説明されると、多数回答があるかもです。

でわ
m(__)m

（隠居じーさん） 2018/03/14(水) 09:42

隠居じーさん様ご助言ありがとうございます。
A1で入力したものは10～20の範囲を超えても表示する　で構いません。B行も同様です。
A行の指定セル（A10）より続けてコピーされていければうれしいです。

＞どの箇所でお困りなのか具体的にエラー、とか、作成されたコード等、説明
初心者なので具体的に表現できず自分でも困っております。
コードも作成できずでおります。すみません。

（チーター） 2018/03/14(水) 11:09

とりあえず。様々な方法が有るとはおもいますが。　＾＾；

'1　変数等定義、当該のシートを指定
'2　操作対象セルを取得
'3　情報の最終行を取得
'4　入力セルＡ１、Ｂ１が空白か否かにより条件分岐
'5　双方とも入力済なら最終行の次の行にＡ、Ｂそれぞれ値を転記
'6　Ｂ列の書式を設定
'7　Ａ１、Ｂ１を初期化
'8　開発タブのマクロから作成したマクロを指定して実行

 VBA　上記項目
で検索かければ多分いろいろあると思いますので。
コード、書いてみてください。

（隠居じーさん） 2018/03/14(水) 12:01

隠居じーさん様、ご助言ありがとうございます。
調べて勉強させてもらいます。

（チーター） 2018/03/14(水) 15:59

 こんばんは　＾＾
いちおう作ってみましたので。後はお勉強いただく。と言う事で。
何かの参考まで。あまり参考にはならないかもしれませんが。
他の方のご回答もお待ちください。

 Sheet1モジュールに

 Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 2 Then
        Exit Sub
    End If
    If Application.Intersect(Target, Me.Range("A1:B1")) Is Nothing Then
        Exit Sub
    End If
    If Me.Cells(1, 1) <> "" And Me.Cells(1, 2) <> "" Then
        Application.EnableEvents = False
        Call Module1.main
        Application.EnableEvents = True
    Else
        Exit Sub
    End If
End Sub

 標準モジュールに

 Option Explicit
'**********************************************************
Sub main()
    Call btnmk
End Sub
Private Sub btnmk()
    Dim br As Range
    With ThisWorkbook.Worksheets("Sheet1")
        Set br = .Range("F3:G4")
        With .Buttons.Add(br.Left, br.Top, br.Width, br.Height)
            .OnAction = "Module1.colapp"
            .Characters.Text = "BTN"
        End With
    End With
 End Sub
Private Sub colapp()
    '途中で誰かＡ１かＢ１消した場合の後始末
    With ThisWorkbook.Worksheets("Sheet1")
        If .Cells(1, 1) = "" Or .Cells(1, 2) = "" Then
            Call btn_del
            Exit Sub
        End If
    End With
    Dim sh01 As Worksheet, rr As Range, lr As Long
    Set sh01 = ThisWorkbook.Worksheets("Sheet1")
    Set rr = sh01.Range("A2").CurrentRegion
    lr = rr.Rows.Count
    If sh01.Cells(1, 1) <> "" And sh01.Cells(1, 2) <> "" Then
        rr(lr + 1, 1) = sh01.Cells(1, 1)
        rr(lr + 1, 2).NumberFormat = "m月d日"
        rr(lr + 1, 2) = sh01.Cells(1, 2)
    Else
        sh01.Cells(1, 1).Select
        Exit Sub
    End If
    sh01.Cells(1, 1) = ""
    sh01.Cells(1, 2) = ""
    sh01.Cells(1, 1).Select
    Call btn_del
End Sub
Private Sub btn_del()
    Dim BTN As Object
    For Each BTN In ThisWorkbook.Worksheets("Sheet1").Buttons
        BTN.Delete
    Next
End Sub

（隠居じーさん） 2018/03/14(水) 17:29

チーターさん　すみません。　＾＾；

コマンドボタンが複数起動される場合があるようです。
標準モジュールのcolappのbtn_del呼び出し部分は削除し、
btn_delをパブリックに変更後、シート1のChangeイベント
の方で不必要な場合btn_delをコールする。
で、お願いいたします。

でわ

m(__)m

（隠居じーさん） 2018/03/15(木) 07:19

追伸の修正
上記は取消で
下記のとおりです。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
コマンドボタンが複数起動される場合があるようです。
btn_delをパブリックに変更後、シート1のChangeイベント
の方で不必要な場合btn_delをコールする。
を追加で、お願いいたします。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
要するにエンドユーザー対応（完全に近いエラー処理）は出来ておりませんです。＾＾；；；

でわ

m(__)m

（隠居じーさん） 2018/03/15(木) 07:31

 隠居じーさんさんのを弄って

 別にボタンを出したり消したりする必要がないと思ったのと、
 IFの分岐で無駄が多いと感じたのでとりあえず削れるだけ削りました。

 あと提示された例で「lr = rr.Rows.Count」はダメだと思います。

 Private Sub colapp()

 Dim lr As Long
 lr = cells(Rows.Count, 1).End(xlUp).Row

 If cells(1, 1) <> "" And cells(1, 2) <> "" Then

     cells(lr + 1, 1) = cells(1, 1)
     cells(lr + 1, 2).NumberFormat = "m月d日"
     cells(lr + 1, 2) = cells(1, 2)
     cells(1, 1) = ""
     cells(1, 2) = ""

 End If

 End Sub

 上記をボタンに登録するだけ
（774） 2018/03/15(木) 09:01

 Altキーを押しながらF11キーを押す
 挿入→標準モジュール

 下記コードを貼り付け

 Sub 転記()

     Dim LastRow As Long

     LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

     If Application.CountA(Range("A1:B1")) <> 2 Then
        MsgBox "未入力の項目があります", vbExclamation
        Exit Sub
     Else
        If Range("A10").Value = "" Then
           Range("A1:B1").Copy Range("A10")
        Else
           Range("A1:B1").Copy Range("A" & LastRow)
        End If
     End If

     Range("A1:B1").ClearContents

 End Sub

 VBE画面を閉じて開発タブ（※）選択
 挿入→フォームコントロールのボタンを選択
 任意の場所にボタンを作る
 マクロの登録ダイアログボックスが出てくるので「転記」を選択してOKボタンを押す

 ※開発タブがない場合はファイル→オプション→リボンのユーザー設定
   右側のメインタブの開発にチェックを入れる
（bi） 2018/03/15(木) 09:40

７７４さん　こんにちは　＾＾

＞あと提示された例で「lr = rr.Rows.Count」はダメだと思います。
何分いまだ修行中の身でして。
理由なぞご教授賜れば幸甚です。
宜しくお願い致します。

（隠居じーさん） 2018/03/15(木) 10:00

 隠居じーさんさん

 それはご提示のコードの動作確認をされた上で仰っているのですか？
 こちらで提示されたコードを質問者の提示例で走らせるとA3:B3にコピーされ、以後その下に続く形となっていますが？
（774） 2018/03/15(木) 10:23

774　さん
早速のご返信ありがとうございます。
動作確認は致しております。
只、lr　+　1　としておりますので。無駄だとのご指摘なら。。。
その通りです。
＾＾；
またCurrentRegionをつかっていますので
もし空白行があれば正確な最終行が取得できない、
などで、ご指摘なのかと。
反省はいたしておりました。
何分素人なもので、他にも何か大きなミスが有ったのか、確認の為
ご質問いたしました。
<<_ _>>

（隠居じーさん） 2018/03/15(木) 10:42

チーターさん
774さん　すみません
＾＾
ご指摘の通りでした。
何も無い処からの確認が出来ていませんでした。。いや～＾＾；；；
やらかしてしまいました。
穴があったら入りたいです。　とほほ～
取り急ぎお詫びまで。

<< _ _ >>

（隠居じーさん） 2018/03/15(木) 10:50

 >イメージは
 >A1とB1に入力⇒
 >マクロのボタンをクリックすると
 >A行とB行の最終行に追加されるといったものです。

みなさん難しく考えすぎでは？

シート上にActiveXコントロールのコマンドボタンを配置します。
そしてそのシートのシートモジュールに以下のコードを書きます。

Private Sub CommandButton1_Click()

    Dim rngFrom As Range    '入力するセル
    Dim rngTo As Range      '転記先セル

    'セル範囲の定義
    Set rngFrom = Me.Range("A1:B1")
    Set rngTo = Me.Cells(Me.Rows.Count, "A").End(xlUp).Offset(1)
    If rngTo.Row <= 10 Then Set rngTo = rngFrom.Rows(10)

    'セル範囲が
    With rngFrom
　　　　'全部データで埋まっていたら
        If WorksheetFunction.CountA(.Cells) = .Cells.Count Then
　　　　　　'切って貼る
            .Cut rngTo
        End If
    End With
End Sub
（まっつわん） 2018/03/15(木) 11:07

何も無いセルからスタートなのに
CurrentRegion
を。。。が悪かったようです。
チータさん、私の案は没で
お願いします。

774　さん　フォローありがとうございました。　＾＾
大変勉強になりました。猛反省中
メゲずに頑張りたいと思います。
では
m(__)m

（隠居じーさん） 2018/03/15(木) 11:19

リアルでばたついていたので、遅れて参加です。
全部のレスよんでないので、的外れかもしれませんが、

＞A1で入力したものはA行10～20、B1で入力したものはB行10～20の名前ボックスで指定した範囲に入力
＞A1とB1に入力⇒マクロのボタンをクリックするとA行とB行の最終行に追加される

↑なんか、それぞれ違うことを仰っているような。。。
とりあえず、前者のイメージが理解できてないですが、後者であれば
（１）ボタンクリックというイベントを感知
（２）アクティブシートの最終行＋１を取得
（３）取得した行のA列とB列に書き込む
（４）A1とB１を消去する

ってことなんじゃないかとおもうので、単純にこんなのでいいように思うんですが・・・

Sub Sample2()
'==変数の宣言とか

    Dim 書込行 As Long

'==処理

    With ActiveSheet
        書込行 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

        With .Range("A1:B1")
            .Copy .Parent.Cells(書込行, "A")
            .ClearContents
        End With
    End With
End Sub

ちなみに、ExcelのバージョンとＯＳの組み合わせが変なので、Windows版のExcelと解釈してです。
（Mac版の方が正しいのであれば持ってないので検証できない＆仕様を知らないので動くか解りません。）
（もこな２） 2018/03/15(木) 14:12

皆様、大変助かりました。やりたいことができました。
フォームコントロールの付け方まで手取り足取り教えてくださり大感謝です。

これらを参考に、さらに便利に使わせてもらいます。
本当に、ありがとうございました。

（チーター） 2018/03/15(木) 23:53

コメント返信：

[ 一覧(最新更新順) ]

[[20180313195241]] 『最終行に入力』（チーター） ページの最後に飛ぶ

[[20180313195241]]　『最終行に入力』（チーター）　ページの最後に飛ぶ