[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『下記のコードをループさせたいのです』（なのれい）
いつもお世話になっております。
皆様のおかげで基本的なセルの移動を出来る様になりました。
下記のコードをループさせたいのですが、出来ずに苦戦しております。
Sub 移動準備()
Dim rng As Range, rng2 As Range
Set rng = Range("A2:A350").Find("1", Lookat:=xlWhole)
Set rng2 = Range("B2:B350").Find("1", Lookat:=xlWhole)
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
End Sub
FindNEXTをどの様に使うべきなのか、はたまたFor i = 1 To 320なのか、 DO LOOPなのか
どれを使うのかわからない状態です。
イメージ的には
Sub 移動準備()
Dim rng As Range, rng2 As Range
Set rng = Range("A2:A350").Find("i = 1 To 320", Lookat:=xlWhole)
Set rng2 = Range("B2:B350").Find("i = 1 To 320", Lookat:=xlWhole)
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
End Sub
この様にしたいのですが、アドバイス頂けないでしょうか？
宜しくお願い致します。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
あとイメージってことですが、そもそものFindメソッドの使い方がわかっていなさそうなので↓から先に見たほうがよいかも
http://officetanaka.net/excel/vba/cell/cell11.htm
そのうえで、Findメソッドの引数を省略するのは↓のようなことになるのでオススメしません。
検索に失敗するとき（Findメソッドの引数省略時に起きる失敗）
https://www.moug.net/tech/exvba/0150111.html
（もこな２） 2019/02/06(水) 00:25
URLを参考にして作ってみます。
ありがとうございます。
（なのれい） 2019/02/06(水) 00:30
Dim i(実際はiでなくてもOKですが最初はiで覚えましょう) For i = 最初の数字 To 最後の数字 処理内容 Next i
このように書くことで、処理内容を繰り返し処理することができます。 繰り返しながらｉは 1ずつ増えていき、 i が最後の数字に達したら繰り返し処理を終わります。
なのれいさんは、Findメソッドの検索する値を 1 から 320 まで増やしながら繰り返したいのですよね？
でしたらこのようになります。
Sub 移動準備()
Dim rng As Range, rng2 As Range, i As Long
For i = 1 To 320
Set rng = Range("A2:A350").Find(i, Lookat:=xlWhole)
Set rng2 = Range("B2:B350").Find(i, Lookat:=xlWhole)
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
Next i
End Sub
（TAKA） 2019/02/06(水) 09:21
おはよ〜ございます。 ＾＾ B列の数値の小さい方から大きい方へ順に並び替え ておられるのでせうか。 だとすれば 並び替えたい順に番号振る手間はいりますすが。。。 Sort なども 使えるのではないでしょうか。 いらぬお世話でしたら済みません。m(__)m マクロ。。。楽しいですね ＾＾ｖ でわ
（隠居じーさん） 2019/02/06(水) 09:56
追伸 私の勘違いだったみたいで。。。 (￣▽￣；) 無視してください。 コード処理の練習みたいで楽しかったです お邪魔しました。 すみません
（隠居じーさん） 2019/02/06(水) 10:02
こちらのコードも帰宅したらすぐに勉強させて頂きます。
ありがとうございます。
隠居じーさんさんコメントありがとうございます。
移動後の場所のセルが空で無ければ撤去（全く違う列へ）
空であれば入れる
というルールで
並び替えだと上手くいかないんです。
めっちゃ初心者ですけど、少しずつ理解出来る所も増えて楽しいです。
どんなコメントでもお待ち致しております。
（なのれい） 2019/02/06(水) 11:54
皆様お疲れ様です。
Sub 移動準備()
Dim rng As Range, rng2 As Range, i As Long
For i = 1 To 320
Set rng = Range("A2:A350").Find(i, Lookat:=xlWhole)
Set rng2 = Range("B2:B350").Find(i, Lookat:=xlWhole)
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
Next i
End Sub
文字がなかった場合エラーが起きてしまい、つまずいてしまいました。
If rng Is Nothing Then
MsgBox "みつかりませんでした。"
Else
MsgBox rng.Row
End If
とか
If Not Rng Is Nothing Then
Rng.Font.Bold = True
End If
などNothingについて調べてみましたが、上手く出来ませんでした。
アドバイス頂けないでしょうか？
（なのれい） 2019/02/06(水) 21:50
んっと、、、
http://officetanaka.net/excel/vba/cell/cell11.htm
↑の【Findメソッドで見つからなかったとき】
のところには目を通しましたか？
（もこな２） 2019/02/06(水) 22:43
検索に失敗するとき（Findメソッドの引数省略時に起きる失敗） https://www.moug.net/tech/exvba/0150111.html
（もこな２） 2019/02/06(水) 22:45
目を通しましたが、理解できませんでした。
一応出来る限りやってみようと思い、下記のコードにしましたがやはりダメでした。
Sub 移動準備?A()
Dim FoundCell As Range, rng2 As Range, i As Long
For i = 1 To 320
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
Set rng2 = Range("A2:A305").Find(i, Lookat:=xlWhole)
rng2.Offset(0, 1).Cut FoundCell.Offset(0, 2)
Next i
If FoundCell Is Nothing Then
MsgBox "検索に失敗しました"
Else
FoundCell.Select
End If
End Sub （なのれい） 2019/02/06(水) 23:18
最初のA列,B列を検索、C列をD列へ移動のパターンで。。。 見当違いでしたら済みません。 処理対象シート名。。。Sheet1
Option Explicit
Sub 移動準備()
Dim rng As Range
Dim rng2 As Range
Dim i As Long
Dim lastrow
Dim buf As String
Dim tflg As Boolean
With Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Set rng = .Range("A2:A" & lastrow & "").Find(i, , xlValues, xlWhole, xlByRows, , False, True, False)
Set rng2 = .Range("B2:B" & lastrow & "").Find(i, , xlValues, xlWhole, xlByRows, , False, True, False)
If rng Is Nothing Or rng2 Is Nothing Then
If i < lastrow Then
buf = buf & i & vbCrLf
tflg = True
End If
Else
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
End If
Next i
End With
If tflg Then MsgBox buf & "行目の情報が不適切な可能性が有ります。"
End Sub
おやすみなさい m(_ _)m。。。。。ｚｚｚｚｚｚｚ （隠居じーさん） 2019/02/06(水) 23:43
(1)「test1」は何をやっているかわかりますか？↓の【】を埋めてください
アクティブシートのセル範囲（E2:E305）から【 】を探して、 変数FoundCellに代入ではなく【 】そのものをセットしている。
(2)「test1」で該当セルが見つからない場合、変数FoundCellには何が入って（セット）されますか？
Sub test1()
Const i As Long = 1
Dim FoundCell As Range
Set FoundCell = Range("E2:E305").Find(i, LookIn:=xlValues, Lookat:=xlWhole)
End Sub
※上記コードは標準モジュールに記述されているものとする。
（もこな２） 2019/02/07(木) 00:21
アクティブシートのセル範囲（E2:E305）から【 i 】を探して、 変数FoundCellに代入ではなく【 数値 】そのものをセットしている。
(2)に関してですが、わかりません。
（なのれい） 2019/02/07(木) 01:02
アクティブシートのセル範囲（E2:E305）から【セルの「値」が1となっている「セル」】を探して、 変数FoundCellに代入ではなく【セル 】そのものをセットしている。
です。
(1)、(2)共に、↓をもう一度よく読んでください。
http://officetanaka.net/excel/vba/cell/cell11.htm
とくにこの部分
Findメソッドは、引数Whatに指定した検索値が見つかった場合は、見つかったセル(Rangeオブジェクト)を返します。
見つからなかった場合はNothingという特別な状態を返します。
というわけで、(2)の正解は、Nothing です。
そのうえで、こんなところにも注目しましょう。
重要なことは「Nothingはセル(Rangeオブジェクト)ではない」ということです。セル(Rangeオブジェクト)ではないのですから、当然Selectメソッドで選択することもできません。
上記は、Selectメソッドの例で書いてありますが、コピー、切取り、貼付も無理です。
なぜなら【セル】じゃないので・・・
ということで、Range型変数の中身がNothingだった場合、コピーや切取り、貼付はできないわけですから、
もし、○○がNothingだったら、プログラム終了
というような命令は、cutなどをする命令より【前の行】で記述しなければなりません。
（もこな２） 2019/02/07(木) 02:59
了解致しました。
上記の事を踏まえてもう一度作り直してみます。
隠居じーさんさん返信ありがとうございます。
時間少なくてまだ軽くしか見れていないのですが、思い通りに動いてくれてました。
Nothingの件が理解出来たら、もう一度深く調べて自分のものに出来る様頑張ります。
ありがとうございます。
（なのれい） 2019/02/07(木) 09:51
Sub 移動準備?A()
Dim FoundCell As Range, rng As Range, i As Long
For i = 1 To 320
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
Set rng = Range("A2:A305").Find(i, Lookat:=xlWhole)
If FoundCell Is Nothing Then
Else
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2)
End If
Next i
End Sub
もこな2さん上記のコードで上手くいきました。
If FoundCell Is Nothing Then
無かった時の処理、メッセージはいらないので何もないです。
Else
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2) あった時の処理
Rangeオブジェクトなので、Setステートメントを使わないといけない。
If文でNothingの判定を行うにはIs演算子。
もこな2さんこちらでいかがでしょうか？
（なのれい） 2019/02/07(木) 19:16
■まず、１点目としてダメではないですが、↓の部分について
If FoundCell Is Nothing Then
'無かった時の処理、メッセージはいらないので何もないです。
Else
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2) あった時の処理
End IF
↓でも書きましたけど
[[20190205021012]] 『ＶＢＡで複数選択し、切り取り貼り付けしたいです』（なのれい）
If Not FoundCell Is Nothing Then
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2) 'あった時の処理
End IF
としたほうが見やすいと思います。
■2点目として、
Findメソッドの結果が見つからなかったであれば、Nothingが返されるのは説明の通りです。
そうすると、
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
↑が見つかってない場合 【FoundCell】にはNothignが入ってますよね
その考えで、↓が見つからない場合、【rng】の中身はなんですか？
Set rng = Range("A2:A305").Find(i, Lookat:=xlWhole)
踏まえると、下記の部分ちょっとまずいですよね。修正してみましょう。
（すでに隠居じーさんさんが答えを投稿されているので、答えがわからなければ研究されるとよいです。）
If Not FoundCell Is Nothing Then
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2) 'あった時の処理
End IF
■3点目として
↓は読んでいただけましたか？
検索に失敗するとき（Findメソッドの引数省略時に起きる失敗） https://www.moug.net/tech/exvba/0150111.html
そうすると、例えば↓は【値】が1のセルがあっても、【前回検索の状況によっては】見つからないことがあるのはわかりますよね？
Set rng = Range("A2:A350").Find(1, Lookat:=xlWhole)
■4点目として
そもそも、どんなものを処理されようとしているのかよくわからないので、簡単なレイアウト（5行分くらい）の提示があると回答しやすいです。
個人的には、
・Findメソッドで検索をする必要性が薄い気がしてならない
・そもそも、検索をする必要がないんじゃないか
と思ったりしてます
■5点目として
4点目と関連しますが、検索対象に合致するものが複数あったりしますか？
For i = 1 To 320 のときに 2〜305行目を処理なので重複がないとしても、1〜320のうち無いものがあるのはわかりますが、条件に合致するものが対象が複数ある場合、上手くいったというコードではちょっとまずいと思います。
Findメソッドは、最初に見つかった１セルしか返しませんから・・・
（もこな２） 2019/02/08(金) 06:35
例えば、A2:A305のなかから、値が「1」のセル（例えばA11に条件に合致するものがある）を探す場合
Sub さんぷる1()
Dim buf As Long
With Range("A2:A305")
buf = WorksheetFunction.Match(1, .Cells)
MsgBox .Cells(buf).Address(0, 0) & " で発見しました。"
End With
End Sub
いろいろ手抜きしてますが、こんな感じでOKです。
問題は見つからない（条件に合致するものがない）場合です、
見つからない場合、上記では
buf = WorksheetFunction.Match(1, .Cells)
この部分で実行時エラーが発生します。
なのでエラーを無視・・・・としてもよいのですがこのようにする方法もあります。
Sub さんぷる2()
Dim buf As Variant '←Variant型（なんでも型）で宣言
With Range("A2:A305")
buf = Application.Match(1, .Cells)
If Not IsError(buf) Then 'bufがエラー値であるか（の反対であるか）判定
MsgBox .Cells(buf).Address(0, 0) & " で発見しました。"
End If
End With
End Sub
↑このように修正すると、MATCH関数がエラーになった場合、実行時エラーが発生するのではなく、エラー値というものを取得するようになります。
あとは、エラー値じゃなかったら処理するようにしてやればよいです。
蛇足話ですが、Findメソッドが【セル】を探すのに対して、MATCH関数は、【値】が【何番目】にあるかを探すという違いはありますが、一口に検索と言ってもいろんな方法があるということでご理解ください。
（もこな２） 2019/02/08(金) 07:33
これでいいのかな、、
Sub 移動準備()
Dim rng As Range, rng2 As Range, i As Long
For i = 1 To 320
Set rng = Range("A2:A350").Find(i, Lookat:=xlWhole)
Set rng2 = Range("B2:B350").Find(i, Lookat:=xlWhole)
If Not rng Is Nothing And Not rng2 Is Nothing Then
rng.Offset(0, 2).Cut rng2.Offset(0, 2)
End If
Next i
End Sub
（TAKA） 2019/02/08(金) 10:03
Findメソッド(検索の命令)はちょっと特殊で、【戻り値】がある命令です。
例えばSelectメソッド(選択)は選ぶことが目的であり、選ぶことで完結する命令です。 他にもDeletメソッド(削除)なんかも消すことが目的であり、消すことで完結する命令ですよね？ こういう命令には戻り値はありません。
ただ、検索の場合はどうでしょうか。 探すことが目的で、探すことで完結する命令ですか？
違います。探すだけでは何も起きません。
例えば部下に「あの書類を探してきてくれ」と頼んで、 部下が探して終わってしまっては困ります。 探して、見つかったなら持ってきて欲しいし、 見つからなかったなら報告が欲しいですよね？ 探すだけでは困ります。
探して、見つかったセルを扱いたいから、検索するわけですよね？
そのため、Findメソッドは検索を行うだけではなく、 見つかったセルを【戻り値】として返します。
Set rng = Range("A2:A350").Find(i, Lookat:=xlWhole)
と書くことで、A2からA350の範囲からi を探して、 戻り値、つまり見つかったセルを 変数rngに格納します。
なので、たとえばi が A200 にあったとしたら、rngにはA200 が格納されます。
じゃあもしも 探しても見つからなかったら どうなるのでしょうか。
その場合は Findメソッドは【 Nothing 】という戻り値を返します。 日本語で言えば、「探したけど無かったよ〜」ということです。 そうするとrng には Nothing が入るということになりますよね？
Nothing は状態であって、オブジェクトではありません。
Select , Cut , Copy , Delete などの命令はオブジェクトに対して行うものなので rng.Offset(0,2).Cut と書いた場合、rngにきちんとオブジェクトが入っていれば機能しますが rngがNothingの時にはエラーになります。
そのため、Findメソッドを使う際には なかったときのことを考えて、次のように条件分岐で書くのが基本です。
Dim rng As Range
Set rng = Range("A2:A350").Find("1", Lookat:=xlWhole)
If rng Is Nothing Then
'見つからなかった場合の処理
Else
'見つかった場合の処理
End If
（TAKA） 2019/02/08(金) 10:43
>例えばSelectメソッド(選択)は選ぶことが目的であり、選ぶことで完結する命令です。 >他にもDeletメソッド(削除)なんかも消すことが目的であり、消すことで完結する命令ですよね？ >こういう命令には戻り値はありません。 処理が成功した場合にTRUEを戻り値としているようだ。
（ねむねむ） 2019/02/08(金) 10:59
ヘルプではRange.Selectでは戻り値:バリアント型となっている。
Worksheet.Selectでは戻り値があるとの記載がないが実際にはイミディエイトウィンドウで
?Worksheets("Sheet1").Select
などとするとTrueと返ってくる。
（ねむねむ） 2019/02/08(金) 11:02
Sub A()
Dim B
B = Range("A1").Select
MsgBox B
End Sub
ほんとだ、、知りませんでした、、 名前付き引数が括弧でくくられていなくても戻り値がある場合があるとは、、
（TAKA） 2019/02/08(金) 11:05
ひょっとすると全ての命令に戻り値があるのかな、、 色々試してみます、ありがとうございました。
（TAKA） 2019/02/08(金) 11:11
引数を指定する場合のみ、 【戻り値を使うなら】引数を括弧で囲む必要がある
ってことか。理解しました。
＞なのれいさん 間違ったことをぺらぺらとすみませんでした、、 穴があったら入りたい、、 （TAKA） 2019/02/08(金) 11:27
現在、皆様の思考についていけない状態でいっぱいいっぱいですので回答漏れありましたら連絡頂ければと思います。
それでは、
もこな2さん返信ありがとうございます。
1点目
・了解致しました。修正致します。
2点目
・If Not rng Is Nothing 付け足す。
もしくは
If Not FoundCell Is Nothing Then
If Not rng Is Nothing
を組み合わせたコードにする必要がある。
3点目
・数式だとダメという事を仰っているのでしょうか？検索する列は数値か空白のどちらかになっております。
4点目
・次のコメントに記載いたします。
5点目
・検索する数値は1つしかないです。1が重複、2が重複…する事はありません。
ねむねむさん、TAKAさん
返信ありがとうございます。
すみませんが、理解できる様頑張ります。
皆様ありがとうございます。
次のコメントでエクセルの表の説明致します。
（なのれい） 2019/02/08(金) 12:44
Sub 移動準備?A()
Dim FoundCell As Range, rng As Range, i As Long
For i = 1 To 570
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
Set rng = Range("A2:A305").Find(i, Lookat:=xlWhole)
If Not FoundCell Is Nothing Then
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2)
End If
Next i
End Sub
訂正
・For i = 1 To 570
・If Not FoundCell Is Nothing Then
A B C D E F G H I J
1 現場所 移動先 撤去商品
2 1 商品名
3 2
4 3
5 5
6 6
7 7
8 8
9 10
・
・
・
・
・
305 570
訂正
・For i = 1 To 570
・If Not FoundCell Is Nothing Then
A列には4と9が抜けた1〜570の商品棚番号が入ってます。
B列には棚に入ってる商品名が入ります。
E列にはB列の商品の移動先の番号が入り、F列には移動する商品名が入ります。（今回のコードの件）
F列に商品があり、尚且つB列にも商品があれば、B列は撤去なのでH列へ移動になります。
F列に商品があったら、B列に移動します。
B列に空白が残ると思いますが、そちらは新商品を入力していきます。
以上になります。
（なのれい） 2019/02/08(金) 13:26
こんにちは ＾＾ 多少問題ありのコードの様な気がしないでもありませんが｡ ラスト行取得は一つでよかったかも｡｡｡ 何かの参考にでも｡｡｡ 合ってるかどうかは解りません。。。(￣▽￣；)。。。m(_ _)m
Sheet1 に下記の実験データー
A B C D E F G H
1 現場所 A B 移動先 移動商品 C 撤去商品
2 1 商品B2 3
3 2 商品B3 4
4 3 商品B4 5
5 5 商品B5 6 きつね
6 6 7 うどん
7 7 商品B7 8 プルドビーフ
8 8 商品B8 9
9 10 商品B9 10
10 11 商品B10 11
11 12 商品B11 12
12 13 商品B12 13
13 14 商品B13 14
14 15 商品B14 15 たぬき
15 16 商品B15 16
16 17 商品B16 17
17 18 18 そば
18 19 19 からあげ
19 20 商品B19 20
20 21 商品B20 21
Sheet1 このように、なりましたよ。＾＾
A B C D E F G H
1 現場所 A B 移動先 移動商品 C 撤去商品
2 1 商品B2 3 商品B4
3 2 商品B3 4
4 3 5 商品B5
5 5 6
6 6 きつね 7 うどん 商品B7
7 7 8 プルドビーフ 商品B8
8 8 9
9 10 10 商品B9
10 11 11 商品B10
11 12 12 商品B11
12 13 13 商品B12
13 14 14 商品B13
14 15 15 たぬき 商品B14
15 16 16 商品B15
16 17 17 商品B16
17 18 そば 18
18 19 からあげ 19
19 20 20 商品B19
20 21 21 商品B20
Option Explicit
Sub main()
Dim sh01 As Worksheet
Dim i As Long
Dim j As Long
Dim A_lastr As Long
Dim F_lastr As Long
With Worksheets("Sheet1")
A_lastr = .Cells(.Rows.Count, 1).End(xlUp).Row
F_lastr = .Cells(.Rows.Count, 5).End(xlUp).Row
For i = 2 To A_lastr
For j = 2 To F_lastr
If .Cells(i, 1) = .Cells(j, 5) Then
If (.Cells(i, 2) <> "") * (.Cells(j, 6) = "") Then
.Cells(i, 2).Cut .Cells(j, 6)
ElseIf (.Cells(i, 2) = "") * (.Cells(j, 6) <> "") Then
.Cells(j, 6).Cut .Cells(i, 2)
ElseIf (.Cells(i, 2) <> "") * (.Cells(j, 6) <> "") Then
.Cells(i, 2).Cut .Cells(j, 8)
End If
End If
Next
Next
End With
End Sub
（隠居じーさん） 2019/02/08(金) 16:26
Dim sh01 As Worksheet は消し忘れです。済みません。 消してくださいね。
Ａ＾＿＾；
m<< _ _ >>m （隠居じーさん） 2019/02/08(金) 16:35
好みの問題ですからまぁ参考程度で。
■２点目
隠居じーさんさんの
If rng Is Nothing Or rng2 Is Nothing Then
↑を参考に↓のようにしてみては？
If Not FoundCell Is Nothing And Not rng Is Nothing Then
※ちょっと例がわかりづらかったかも。ごめんなさい。
■３点目
↓を貼り付けてそのまま実行してみてください。
Sub 実験用()
Dim FoundCell As Range
Const i As Long = 1
Set FoundCell = Range("E2:E305").Find(i, LookIn:=xlComments, Lookat:=xlWhole)
'↑と↓で違うところはどこでしょうか？
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "みつかりません"
Else
MsgBox FoundCell.Address(0, 0) & " がヒットしました"
End If
End Sub
あるはずなのに「みつかりません」って出ませんか？
■４点目
レイアウトって言ったのがまずかったです。
処理前の状況がどんな感じで、処理後にどうなってほしいのかっていうのを示してほしいという意味です。
■５点目
該当セルは複数存在しないのですね。
であれば【FindNextメソッド】は、今回は関係ないです。
（もこな２ ） 2019/02/08(金) 16:56
Sub 移動準備?A()
Dim FoundCell As Range, rng As Range, i As Long
For i = 1 To 570
Set FoundCell = Range("E2:E305").Find(i, Lookat:=xlWhole)
Set rng = Range("A2:A305").Find(i, Lookat:=xlWhole)
If Not FoundCell Is Nothing And Not rng Is Nothing Then
rng.Offset(0, 1).Cut FoundCell.Offset(0, 2)
End If
Next i
End Sub
Sub 撤去()
Dim i As Long
For i = 2 To 570
If Cells(i, "G") = "" Then
Else
Cells(i, "B").Cut Cells(i, "J")
End If
Next i
End Sub
Sub 移動完了()
Dim i As Long
For i = 2 To 570
If Cells(i, "G") = "" Then
Else
Cells(i, "G").Cut Cells(i, "B")
End If
Next i
End Sub
今現在私が作れてるコードです。
E列には違うプログラムで数値を貼り付けしてきます。
訂正
E列には移動前の番号か、空白が入ります。
E列の番号の商品を、その表示された行のB列に移動したいです。
もこな2さん返信ありがとうございます。
上記のコードの移動準備が今のところ成功しています。
A列 4と9を含まない 1〜570が入ります。
E列 移動前の番号が移動先の行のE列に入ります。
皆様上手く伝えれなくて申し訳ありません。
（なのれい） 2019/02/08(金) 17:13
作業前
A B C D E F G H I J
1 現場所 移動先 撤去商品
2 1 ラーメン
3 2 ご飯
4 3 肉 2
5 5 魚
作業後1
A B C D E F G H I J
1 現場所 移動先 撤去商品
2 1 ラーメン
3 2
4 3 肉 2 ご飯
5 5 魚
作業後2
A B C D E F G H I J
1 現場所 移動先 撤去商品
2 1 ラーメン
3 2
4 3 2 ご飯 肉
5 5 魚
作業後3
A B C D E F G H I J
1 現場所 移動先 撤去商品
2 1 ラーメン
3 2
4 3 ご飯 2 肉
5 5 魚
こんな感じで成功になります。
（なのれい） 2019/02/08(金) 17:20
A B C D E F G H
1 現場所 C D 移動先 F G 撤去商品
2 1 らーめん
3 2 ご飯
4 3 肉 2
5 5 魚
で。。。＾＾ きっともっとスマートな方法は有るとは思いますが。。。＾＾；
Option Explicit
Sub Front_Proc()
Dim i As Long
Dim j As Long
Dim A_lastr As Long
With Worksheets("Sheet1")
A_lastr = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To A_lastr
For j = 2 To A_lastr
If .Cells(i, "A") = .Cells(j, "E") Then
.Cells(i, "B").Cut .Cells(j, "F")
End If
Next
Next
End With
proc_1
proc_2
End Sub
Private Sub proc_1()
Dim i As Long
Dim lastr As Long
With Worksheets("Sheet1")
lastr = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastr
If .Cells(i, "F") <> "" And .Cells(i, "B") <> "" Then
.Cells(i, "B").Cut .Cells(i, "H")
End If
Next
End With
End Sub
Private Sub proc_2()
Dim i As Long
Dim lastr As Long
With Worksheets("Sheet1")
lastr = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastr
If .Cells(i, "F") <> "" Then
.Cells(i, "F").Cut .Cells(i, "B")
End If
Next
End With
End Sub
（隠居じーさん） 2019/02/08(金) 19:33
ラーメンが動かないのはE列に1が無いからですか？
肉が、G列に動くのは、その行のF列がブランクで無いためという理解でよいですか？
（もこな２ ） 2019/02/08(金) 19:43
（隠居じーさん） 2019/02/08(金) 20:02
肉が、G列に動くのは、その行のF列がブランクで無いためという理解でよいですか？
F列にご飯があるからG列に移動です。
すみません。上の図だとH列になってます。
撤去は正直どこの列でも構わないです。
私のコードがG列で図がH列で間違いです。申し訳ありません。
（なのれい） 2019/02/08(金) 20:08
その条件であれば、こんな感じでもいけそう。
Sub さんぷる()
Dim MyRNG As Range
Dim buf As Variant
Dim tmp As Range
Stop '←ここで止まるのでステップ実行して研究のこと
With ActiveSheet
'▼作業１
For Each MyRNG In .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
buf = Application.Match(MyRNG.Offset(, -1).Value, .Range("E:E"), 0)
If Not IsError(buf) Then
MyRNG.Cut .Cells(buf, "F")
End If
Next MyRNG
'▼作業２
On Error Resume Next
Set tmp = .Range("F:F").SpecialCells(xlCellTypeConstants, xlNumbers + xlTextValues)
On Error GoTo 0
If Not tmp Is Nothing Then
For Each MyRNG In tmp
.Cells(MyRNG.Row, "B").Cut .Cells(MyRNG.Row, "H")
Next MyRNG
End If
'▼作業３
If .Cells(.Rows.Count, "F").End(xlUp).Row > 1 Then
With .Range("F2", .Cells(.Rows.Count, "F").End(xlUp))
.Copy
.Parent.Range("B2").PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True
.Clear
Application.CutCopyMode = False
End With
End If
End With
End Sub
（もこな２） 2019/02/08(金) 21:38
たぶん、説明してない方法をかなり使っているので、はじめはわけわからん状態だとおもいます。
全部説明するのもしんどいので、一度ステップ実行していただいて、動きや、変数に何が格納されているかを確認していただいてから、どの部分がわからないのかを挙げて聞くと、私じゃなくても皆さん答えてくださると思います。
（もこな２） 2019/02/08(金) 21:49
提案頂いたコードをしっかりとステップ実行で確認して勉強させていただきます。
皆様ありがとうございました。
（なのれい） 2019/02/08(金) 22:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.