[[20190205021012]]　『ＶＢＡで複数選択し、切り取り貼り付けしたいです』（なのれい）　ページの最後に飛ぶ

『ＶＢＡで複数選択し、切り取り貼り付けしたいです。』（なのれい）

いつもお世話になっております。
マクロ勉強中で初歩的な質問ですが、宜しくお願い致します。

教えて貰ったコードを自分なりに改良して思うように動かしたいです。

  Sub 撤去()　　　
    Dim rng As Range, rng2 As Range
    Set rng = Range("D2:D600").Find("1", Lookat:=xlWhole)
    If rng Is Nothing Then
        MsgBox "D列"
        Exit Sub
    End If
    rng.Offset(0, -1).Cut rng.Offset(0, 5)
 End Sub

1　タイトル
2　理解できていません
3　D2～D600の範囲で、１を探します。「１」は完璧に一致
4　もし1が無かった場合
5　メッセージでD列と表示
6　理解できていません
7　理解できていません
8　選択セルの一つ左を切り取り、そこから右へ五つ隣へ貼り付け
9　終了

この様な解釈をしております。

今回の質問ですが、理解出来ていない所の意味を教えて頂けないでしょうか？
また、「1」の隣をではなく何かしらの文字がある場所の左隣を切り取りたいです。
さらに、複数選択出来る様にしたいです。

宜しくお願い致します。

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

 わからないところは文字列コピーして検索かければ全部でてきますよ

 2は変数宣言です
https://excel-ubara.com/excelvba1/EXCELVBA312.html

 6はプロシージャの終了です
http://officetanaka.net/excel/vba/statement/Exit.htm

 7はIfステートメントです

 繰り返して検索する=複数選択で考えあってますか？
https://programming-study.com/technology/vba-findnext/

 ＞「1」の隣をではなく何かしらの文字がある場所
 Findメソッドの1の部分を目的の文字に置き換えてください
 上に提示したFindnextの記事が参考になると思います
（稲葉） 2019/02/05(火) 06:00

稲葉さん返信ありがとうございます。

１では無く、何か文字が書いてあったらにしたいです。

空白なら、メッセージ
何でもいいから文字なら、切り取り貼り付け

にしたいです。

他は頂いた物を参考にし、頑張ってみます。
ありがとうございます！！！
（なのれい） 2019/02/05(火) 06:57

 Findワイルドカード
 で検索してください
（稲葉） 2019/02/05(火) 07:13

稲葉さん了解です。

ありがとうございます。
（なのれい） 2019/02/05(火) 07:23

 ＞また、「1」の隣をではなく何かしらの文字がある場所の左隣を切り取りたいです。 
  さらに、複数選択出来る様にしたいです。

 D列の中で、何かしら文字が入ってるセルの一つ左を全て切り取って、
 該当行のI列に貼り付ける。
 もし空白のセルがあればメッセージを表示してマクロを終了する。

 ということですか？

 そういうことならFindを使うよりも
 繰り返し処理と条件分岐だけで書いた方が簡単だと思います。

 Sub Sumple2()
    Dim i As Long
    For i = 2 To 600
        If Cells(i, "D") = "" Then
            MsgBox "Ｄ列"
            Exit Sub
        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
 End Sub

（TAKA） 2019/02/05(火) 09:51

TAKAさんいつもありがとうございます。

 D列の中で、何かしら文字が入ってるセルの一つ左を全て切り取って、
 該当行のI列に貼り付ける。
 もし空白のセルがあればメッセージを表示してマクロを終了する。
 ということですか？
仰る通りでございます！

Sub Sumple2()

    Dim i As Long
    For i = 2 To 600
        If Cells(i, "D") = "" Then
            MsgBox "Ｄ列"
            Exit Sub
        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
 End Sub

2行目～600行目を作業します。
もしi行目のD列に文字が入っていなかったら
メッセージＤ列
プロシージャの終了
条件を満たさなかった場合
i行目のＣ列を切り取り、i行目のＩ列へ貼り付け
IFステートメント
次のi行目へ

上記の様に解釈致しました。
私の上記の解釈が正しければ、これで上手く行くかもしれないです。

帰宅したらすぐにやって、結果報告致します！
ありがとうございます！

（なのれい） 2019/02/05(火) 11:55

2行目～600行目を作業をします

これは違いましたね。

iには2～600が入ります。

が正解だと思います。

何か間違いありましたら、ご指摘宜しく御願い致します。
（なのれい） 2019/02/05(火) 11:58

 「もしも i行目 の Ｄ列が空欄だったら メッセージを出して終了。
  そうじゃなかったら i行目 の C列を切り取って I列に 貼り付ける。」
  この作業を i が 2 から 600 になるまで繰り返す。

という解釈です。合っています。
（TAKA） 2019/02/05(火) 12:01

TAKAさん
上記のコードを行ったのですが、空白セルで終了をしたくないです。
空白セルなら、下の行が空白か文字があるかの処理に繋げたいです。

  Sub 撤去()
    Dim i As Long
    For i = 2 To 600
        If Cells(i, "D") = "" Then
            MsgBox "Ｄ列"

        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
 End Sub

上記の様にExit Subを消して実行したら、Ｄ列のメッセージが約600件来て焦りました。

Ｄ列の文字は600行中、20件程度になります。

すみませんが、アドバイスよろしくお願いいたします。

（なのれい） 2019/02/05(火) 17:56

下記のコードでうまくいくのですが、
いかがでしょうか？

Sub 撤去()

    Dim i As Long
    For i = 2 To 600
        If Cells(i, "D") = "" Then

        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
 End Sub

何か問題点がありそうでしたら、ご指摘宜しくお願い致します。
（なのれい） 2019/02/05(火) 18:28

問題はないけど、こういうやり方もありますよ。

    Sub 撤去_別案1()
        Dim MyRNG As Range
        For Each MyRNG In Range("D2:D600")
            If MyRNG <> "" Then
                MyRNG.Offset(, -1).Cut Cells(MyRNG.Row, "I")
            End If
        Next MyRNG
     End Sub

また、動きますし問題点というほどでもないですが、元のコードのIFステートメントが「条件を満たすとき」の部分になにも書かないで、「満たさない時」だけ書いてあるので、そうであれば、

    If Not Cells(i, "D") = "" Then
        Cells(i, "C").Cut Cells(i, "I")
    End If

とか、

    If Cells(i, "D") <> "" Then
        Cells(i, "C").Cut Cells(i, "I")
    End If

のようにしたほうが後で見やすいとおもいます。

（もこな２） 2019/02/06(水) 00:51

たぶん↓のへんから話がず～っと続いてるんですよね？
[[20190204105016]]　『Ａ列から特定の文字を探し、そのセルを選択したい』（なのれい）
[[20190205021012]]　『ＶＢＡで複数選択し、切り取り貼り付けしたいです』（なのれい）
[[20190205234302]]　『下記のコードをループさせたいのです』（なのれい）

そのうえでですが、
＞また、「1」の隣をではなく何かしらの文字がある場所の左隣を切り取りたいです。
おっしゃるものが、文字列が入ってるセルの左側だけとかであれば、実は判定は要りません。。

手動操作で

 (1)D2～D600を選択
 (2)ctrl + G を押して「ジャンプ」ウィザードを起動
 (3)「セル選択」をクリックして「選択オプション」ウィザードを起動
 (4)「定数」を選んで「文字」だけにチェックが入っている状態にして「OK」をクリック

↑をマクロの記録でコード化してみると、なんらかの文字列が入ってるセルを取得する方法がわかるとおもいますよ。

（もこな２） 2019/02/06(水) 01:49

もこな２さんいつもありがとうございます。

仰る通りです。
そんな方法があったなんて知らなかったです。

現在は違う箇所のループを出来る様に頑張っております。

いつも丁寧に教えて頂きありがとうございます。

（なのれい） 2019/02/06(水) 02:27

 繰り返しが2から600までになっているので
 600行目までの空白の数だけメッセージボックスが出てきたらうっとうしいので
 Exit Sub で抜けるようにしておきました。

 抜けて欲しくないのであれば

  Sub 撤去()
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        If Cells(i, "D") = "" Then
            MsgBox "Ｄ列"
        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
 End Sub

 ただ、これでもやはり何度もメッセージが出てしまうと思うので、
 こんなやり方もあります。

 Sub 撤去()
    Dim i As Long, 判定用の変数 As Long
    For i = 2 To 600
        If Cells(i, "D") = "" Then
            判定用の変数 = 1
        Else
            Cells(i, "C").Cut Cells(i, "I")
        End If
    Next i
    If 判定用の変数 = 1 Then MsgBox "Ｄ列"
 End Sub

 600行目までに空欄が一つでもあれば、処理が全て終わったあと、最後にメッセージを一回だけ出します。

 ※メッセージがいらないということであれば、なのれいさんのｺｰﾄﾞで問題ないですよ！

（TAKA） 2019/02/06(水) 09:11

TAKAさん返信ありがとうございます。

のちほど提案して頂いたコードが、どの様な命令になっているかしっかり1行ずつ理解したいと思います。
ありがとうございます。
（なのれい） 2019/02/06(水) 09:56

コメント返信：

[ 一覧(最新更新順) ]

[[20190205021012]] 『ＶＢＡで複数選択し、切り取り貼り付けしたいです』（なのれい） ページの最後に飛ぶ

[[20190205021012]]　『ＶＢＡで複数選択し、切り取り貼り付けしたいです』（なのれい）　ページの最後に飛ぶ