ＶＢＡ超初心者です

質問

皆さんのお知恵を拝借させてください。

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2007/12/1 ユーザー名 : 101
'
Dim pearend As Integer
Dim code As Integer
Dim codeend As Integer
Dim sheet_name As String
Dim dayend As Date

Sheets("商品名").Select
Range("A4").Select
Selection.End(xlDown).Select
pearend = Selection.Row()

For l = 4 To pearend Step 2
For r = 2 To 3

Cells(l, r).Select

code = Cells(l, r).Value
Select Case code
Case 1000 To 1999
sheet_name = "1000"
Case 2000 To 2999
sheet_name = "2000"
Case 3000 To 3999
ssheet_name = "3000"
Case 4000 To 4999
sheet_name = "4000"
Case 5000 To 5999
sheet_name = "5000"

End Select
Sheets(sheet_name).Select

Range("B4").Select
Selection.End(xlToRight).Select
codeend = Selection.Column()

Range("A5").Select
Selection.End(xlDown).Select
dayend = Selection.Row()

For i = 2 To codeend
If code = Cells(4, i).Value Then
Range(Cells(dayend, i), Cells(5, i)).Select
Selection.Copy
Sheets("商品名").Select
Range("K3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
Next

Next
Next

End Sub

というマクロをつくってみたのですが、何順目かあたりから

For r = 2 To 3

のｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

回答No.1

Nayuta_X · ベストアンサー

プログラムを検証してみましたが、

>For r = 2 To 3
>のｒがなぜか4になっています

を確認出来ませんでした。
どこかコードが、抜けているか確認してください。
また、抜けているコードのどこかに　r=4 となるコードがありませんか??。
記述されているコードでは、rを使用しているのは、下記3項のみで問題は、見つかりません。

For r = 2 To 3
Cells(l, r).Select
code = Cells(l, r).Value

お礼

お返事遅くなりまして申し訳ありませんでした。
no2の方がおっしゃったように”4　にインクリメントします”
ということだったのではないかと思います。
なにぶんまったく初心者なので質問の仕方じたいもトンチンカンでどうも申し訳ありませんでした。

回答No.3

imogasi

こんな長いコードをそのまま質問に貼り付けて出して、回答者に長時間かけて解析させ誤りの箇所を教えてほしいというのは、勝手すぎると思う。教えてもらうなら、負担をかけないそれなりのマナーや努力があってしかるべきでは。
それをやるなら質問者側で下記の努力をしてほしい。
（１）マクロの記録のSelect、Selectionが無駄な行を取っている。
　　　書き換えると相当行数が減る。下記参照。
（２）質問するのにコメントも入れてない。
（３）何をしたいのかも説明なし。コードだけ丸投げ。
（４）質問者のデータが示されていない。全部挙げるのは無理でもサンプル的に上げられるよう工夫するのも勉強のうち。
プログラムはコードロジックの正誤のほかに、データが不適合で、思った結果が出ないことも良く経験する。本当はデータなしのデバッグなんて
考えられないのですが。
（５）Column()、ROW()の括弧はいらないのでは
（６）最大の問題は、＞ＶＢＡ超初心者です、がシートをまたがる処理をいきなり課題としてやる難しさ。
Range(Cells(dayend, i), Cells(5, i)).の箇所などでシートの明示がされていないので、うまく行くのかな。
（７）適当なところへ、Msgbox　（適当な変数）を入れて進行状況を
確認して、不適当箇所の見当をつけては。
ーー
下記は動くという意味ではない（動かないことは確実だ）が、コードを簡略化する私なりの例です。参考になれば。
Sub Macro1()

Dim clr As Integer
Dim code As Integer
Dim codeend As Integer
Dim sheet_name As String
Dim dayend As Date

clr = Sheets("商品名").Range("A4").End(xlDown).Row '()は不要、

For r = 4 To clr Step 2 '４行目から最下行まで
For c = 2 To 3 'BとC列

Select Case Cells(r, c).Value
Case 1000 To 1999
sheet_name = "1000"
Case 2000 To 2999
sheet_name = "2000"
'略　質問には例を少なくして掲出のこと
End Select
'--
codeend = Sheets(sheet_name).Range("B4").End(xlToRight).Column '()は不要？
dayend = Sheets(sheet_name).Range("A5").End(xlDown).Row '()は不要

'---
For i = 2 To codeend 'B列から最右列まで

If Cells(r, c) = Cells(4, i).Value Then
Range(Cells(dayend, i), Cells(5, i)).Copy Sheets("商品名").Range("K3").PasteSpecial
End If

Next
'---

Next
Next
End Sub
ーー
If Cells(r, c) = Cells(4, i).Value Then
Range(Cells(dayend, i), Cells(5, i)).Copy Sheets("商品名").Range("K3").PasteSpecial
の辺で（質問者には自明なんだが）どちらのシートかめ明示が必要なように思う。

お礼

お返事遅くなりまして申し訳ありませんでした。おしゃるとおり質問の仕方自体に問題がありました。反省しています。
今後はできるだけ回答者様の負担にならないよう質問の仕方も変えていくつもりです。

＞Column()、ROW()の括弧はいらないのでは
なるほど、いらないのですか・・。それさえもしりませんでした(__)

　色々ご丁寧におしえていただきましてありがとうございます。

　ポイントのほうは先着順でつけさせていただきますのでご了承ください。

回答No.2

Wendy02

こんにちは。

最初に、今までここで質問されたことを、ざっと見てみました。
初心者でも、今、どのぐらいでしょうか？なかなか、凝ったつくりですね。細かいテクニック的なところは別として、良く出来ていますね。変数の名前のつけ方も、良いと思います。

くだらないことかもしれませんが、pearend は、ちょっと分からなかったけれども（^^;

>ｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

それは気にしなくてよいです。r が、2 ～3　までで、正常にループを終えると、4　にインクリメントします。それで、また、r に　2 が代入されるわけです。

お礼

お返事おそくなりまして申し訳ありませんでした。
”4　にインクリメントすると”いうことでおそらく問題ないのかなと考えています。（すいません、実は意味がわかりませんでした(^_^;)）

ただ、何とかなりそうな感じがしてきました。ありがとうございました。

ちなみに昨日からＶＢＡの本を見ながらちょこちょこやりだしました。
PEAENDはペアの商品の略なのですが、つづりまちがってるかもしれません。^_^;　ありがとうございました。