| |
マクロ初心者です。下記の内容についてマクロを組んでみたのですが、どうしても5.で止まってしまい、6.の作業に移行しません。説明が不十分かもしれませんが、アドバイス頂けると助かります。
"元データ"A列2行目に地域コード、3行目以降に不特定数の商品コードが記入されている。
B列は商品名で、CDE列は販売数量・売上高・粗利が記入されており、このパターンが不特定数繰り返される。
"元データ"のA列は、1つの地域データの後に空白セルが1つあり、その後に次の地域コードがある。
元データシート以降に各地域毎のシートがあり、シート名は地域名になっている(以後地域シート)。
＊地域シートはいくつかの地域コードを含む場合がある
"地域シート"はA列に商品コード、それ以降の列は7行目から月毎の販売数量・売上高・粗利を記入する。"地域シート"の構成は全て同じ。
その時によって記入したい時期が変わるので、"元データ"H列に記入された対象時期の数値で時期を判別。
H列の対象時期の数値は"地域シート"の3行目に時期毎に記入されている(Ex.10月→10)
＜元データシート＞
A列 B列 C列 D列 E列 F列 G列 H列
01行目 記録日 商品名 販売数量 売上高 粗利益 (空白) 時期 102
02行目 1058 ABC USA Inc
03行目 7001 りんご 2 2500 1000
04行目 7002 みかん 5 5500 3000
05行目 7003 バナナ 4 3500 1500
06行目 (空白セル)
07行目 1003 DEC China
08行目 901 サバ 2 2500 1000
09行目 902 さんま 5 5500 3000
＜地域シート＞
A列 B列 C列 D列 E列 F列 G列 H列
01行目 (空白) 販売実績 北米 (空白)
02行目 (空白) ABC USA Inc
03行目 (空白) (空白) (空白) 102
04行目 (空白) (空白) (空白) 9月
05行目 (空白) コード 商品名
06行目 (空白) 数量 売上金額 粗利額
07行目 7001 E7001 りんご 2 2500 1000
08行目 7002 E7002 みかん 5 5500 3000
09行目 7003 E7003 バナナ 4 3500 1500
＜やりたいこと＞
1.："元データ"の地域コードから該当する"地域シート"名を判別
2.："元データ"H列の対象時期で"地域シート"の記入場所を判別。
3.："地域シート"A列の商品コードと、"元データ"A列のコードが一致したら"地域シート"に販売数・売上高・粗利を貼り付ける
4.：3.の作業を"元データ"A列のセルが空白になるまで繰り返し
5.："元データ"の次のデータに移行し、1.から繰り返し
6.："元データ"のB列が空白になるまで繰り返し
5.で止まる時は元データの5行目のコピー&ペーストまで行い、自動的に
終了してしまいます。終了した時点では、ペーストしたセルがアクティブに
なっており、次の得意先コードに移行していない様子です。5.の時点でのmの値は
6なので、なぜ次の地域コードに移行しないのか分かりません。
Sub データ入力マクロ()
Dim ws As Worksheet
i = 2
m = 2
Application.ScreenUpdating = False
Step1:
Worksheets("元データ").Select
' 1.地域シートの検索と定義づけ
Select Case Cells(i, 1)
Case 1085, 1091, 1103, 1039, 1132
Set ws = Worksheets("America")
Case 1230
Set ws = Worksheets("China")
Case Else
MsgBox ("該当する代理店がありません")
End Select
' 2.データを入れる期間の検索
cnt = Worksheets("元データ").Range("H" & 1).Value
ws.Select
d = ws.Range("A3:HS3").Find(cnt).Column
' 3.商品コードでデータを検索 該当セルに貼り付け
Do Until Sheets("元データ").Range("A" & m) = ""
Sheets("元データ").Select
For y = 7 To 210
If Worksheets("元データ").Range("A" & m).Value = ws.Range("A" & y).Value Then
Sheets("元データ").Select
Range("C" & m, "E" & m).Copy
ws.Select
Cells(y, d).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
End If
Next y
' 4.元データの次の行を検索
m = m + 1
Loop
' 5.次の地域コードに移行
If Sheets("元データ").Cells(m, 1) = "" Then
m = m + 1
i = m
End If
' 6.元データのB列が空白セルになるまで繰り返し
c = Range("B1").End(xlDown).Row
Do While m < c
GoTo Step1
Loop
End Sub
以上です。
こちらでは初めての質問で、分かり辛いかと思いますがご助言頂ければ
本当に助かります。どうぞ宜しくお願い致します。
|
|
Haruka
- 15/4/24(金) 11:10 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
