発注担当退職に伴い下記エクセルシートでの発注書作成を引継ぎましたが
不明な点が改善出来ず、途方に暮れています。皆様のお知恵をお借りしたく
何卒、よろしくお願いいたします。
作業の流れは下記の通りです。
1.別のBOOKから基本データを抽出して〔sheet2〕シートへ貼り付け。
2.抽出データを〔発注書〕シートに必要データを転記して店名(会社)
ごとに発注書シートを自動作成していく。
その後、別マクロで保存先へ保存しています。
不明な点は同じ店名(会社名)が3つ以上抽出された場合に2つ分しか
転記されないところです。(毎月多いところで最大4つくらいになります)
抽出データから転記するマクロを調べましたが私では力不足で。。。。。
----------------------------------------------------------------------------------------------
ご参考1 同book 〔sheet2〕シートへの抽出結果
A列(日付) B列(店名) C列(時間) D列(会社名)
1 5月1日 東京店 22:00 東京株式会社
2 5月3日 東京店 23:00 東京株式会社
3 5月8日 東京店 21:00 東京株式会社
4 5月8日 博多店 21:00 博多株式会社
5 5月9日 博多店 22:00 博多株式会社
6 5月3日 岡山店 23:00 岡山株式会社
7 5月2日 横浜店 21:00 岡山株式会社
8 5月1日 大阪店 22:00 大阪株式会社
9 5月4日 大阪店 23:00 大阪株式会社
10 5月6日 大阪店 23:00 大阪株式会社
・ ・ ・ ・
・ ・ ・ ・
----------------------------------------------------------------------------------------------
ご参考2 同book 〔発注書〕シート中段転記先の内容
F列(区分) I列(日付) P列(時間) Y列(数量)
23 勤務 空白セル 空白セル 1名
24 空白セル 空白セル 空白セル 空白セル
25 空白セル 空白セル 空白セル 空白セル
・ ・ ・ ・
・ ・ ・ ・
ご参考3 同book 〔発注書〕シート下段転記先の内容
A列(日付) O列(時間) Y列(内容)
37 空白セル 空白セル 現場対応
38 空白セル 空白セル 空白セル
39 空白セル 空白セル 空白セル
・ ・ ・
・ ・ ・
----------------------------------------------------------------------------------------------
ご参考4 発注書への転記マクロの内容
'抽出データから転記
'***************
Dim tenmei_new
Dim tenmei_old
Dim tanto_data
Dim lower_limit
Dim x, flag1
lower_limit = Worksheets(2).Range("A65536").End(xlUp).Row
flag1 = 1
For x = 1 To lower_limit
If Worksheets(2).Range("D" & x) = tanto Then
tenmei_new = Worksheets(2).Range("B" & x)
'シートのコピー
If tenmei_new <> tenmei_old Then
Worksheets("発注書").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = tenmei_new
'転記
Range("F13") = tenmei_new
Range("A2") = tanto
Range("I23") = Worksheets(2).Range("A" & x)
Range("P23") = Format(Worksheets(2).Range("C" & x), "hh:mm")
Range("A37") = Worksheets(2).Range("A" & x)
Range("O37") = Format(Worksheets(2).Range("C" & x), "hh:mm")
tenmei_old = tenmei_new
Else
Range("I24") = Worksheets(2).Range("A" & x)
Range("P24") = Format(Worksheets(2).Range("C" & x), "hh:mm")
Range("F24") = "勤務"
Range("Y24") = "1名"
Range("A38") = Worksheets(2).Range("A" & x)
Range("O38") = Format(Worksheets(2).Range("C" & x), "hh:mm")
Range("Y38") = "現場対応"
End If
End If
Next x
----------------------------------------------------------------------------------------------
No.3ベストアンサー
- 回答日時:
このコミュは字下げが出来ないので、見易く、先行空白を-にして有ります。
実際には半角空白で置き換えて下さい。
idxと言う変数を使い、1行ずつ下げたセルに転記する様にしています。
Dim tenmei_new
Dim tenmei_old
Dim tanto_data
Dim lower_limit
Dim x, flag1,idx
lower_limit = Worksheets(2).Range("A65536").End(xlUp).Row
flag1 = 1
idx=0
For x = 1 To lower_limit
-If Worksheets(2).Range("D" & x) = tanto Then
--tenmei_new = Worksheets(2).Range("B" & x)
---'シートのコピー
---If tenmei_new <> tenmei_old Then
----Worksheets("発注書").Copy After:=Sheets(Sheets.Count)
----ActiveSheet.Name = tenmei_new
----'転記
----Range("F13") = tenmei_new
----Range("A2") = tanto
----Range("I23") = Worksheets(2).Range("A" & x)
----Range("P23") = Format(Worksheets(2).Range("C" & x), "hh:mm")
----Range("A37") = Worksheets(2).Range("A" & x)
----Range("O37") = Format(Worksheets(2).Range("C" & x), "hh:mm")
----tenmei_old = tenmei_new
---Else
----Range("I" & 24+idx ) = Worksheets(2).Range("A" & x)
----Range("P" & 24+idx ) = Format(Worksheets(2).Range("C" & x), "hh:mm")
----Range("F" & 24+idx ) = "勤務"
----Range("Y" & 24+idx ) = "1名"
----Range("A" & 38+idx ) = Worksheets(2).Range("A" & x)
----Range("O" & 38+idx ) = Format(Worksheets(2).Range("C" & x), "hh:mm")
----Range("Y" & 38+idx ) = "現場対応"
----idx = idx+1
---End If
-End If
Next x
素晴らしいです!思ってた通りの結果が得られます。t_fumiakiさん、この度は大変お世話になりました。ありがとうございます!!
No.2
- 回答日時:
3つとも出来ます。
2つ目の"勤務"を転記するセルがF24です。
3つ目はF幾つですか?
4個目も有るのでしたら、4個目はF幾つですか?
これを教えて貰えれば、相対的に解るので、コードを修正できます。
No.1
- 回答日時:
そうなってますよ。
何か意味があるのでは無いですか。店名が変化した場合と、同じ場合で処理が異なります。
東京
東京
東京
と並んでいる場合。
最初の東京で
F13、A2、I23、P23、A37、O37にだけ転記して
2番目、3番目の東京では
I24、P24、F24、Y24、A38、O38、Y38、だけに上書き転記しています。
発注書シートに何か制約があるのでは無いですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Visual Basic(VBA) Sheet2からオートフィルターで売上日を抽出した件数をカウントし、その件数をSheet1のセルB1 2 2023/01/12 12:24
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Visual Basic(VBA) 他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の 8 2023/01/30 18:48
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Visual Basic(VBA) 飛び地セルの空白判定 2 2022/10/24 15:54
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/15 15:12
- Visual Basic(VBA) Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の 4 2023/01/12 23:40
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
ピボットテーブルで空白セルの...
-
Excel:関数が入っているセルに...
-
数式による空白を無視して最終...
-
Excel > ピボットテーブル「(空...
-
空白セル内の数式を残したまま...
-
「データ要素を線で結ぶ」がチ...
-
エクセル セルのコピー元が空...
-
関数TRANSPOSEで空白セルを0に...
-
vlookup にて、返す値が、空白...
-
【Excel】 Ctrl+方向キー で空...
-
【Excel】 csvの作成時、空白セ...
-
エクセルで数式の入ったセルの...
-
エクセルでCSVを編集するとき、...
-
VBA スペースが入力されて...
-
SUMIFS関数で「計算式による空...
-
エクセルで、「複数のセルの中...
-
エクセル 連番が途切れていると...
-
エクセルで上の行の値を自動的...
-
エクセルで、合計をもとめたい...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
エクセルでCSVを編集するとき、...
-
ピボットテーブルで空白セルの...
-
excel2010 空白セルにのみ貼り...
-
Excel > ピボットテーブル「(空...
-
空白セル内の数式を残したまま...
-
「データ要素を線で結ぶ」がチ...
-
エクセルで、「複数のセルの中...
-
Excelで、入力文字の後に自動で...
-
エクセル 連番が途切れていると...
-
《Excel2000》SUMPRODUCT関数で...
-
SUMIFS関数で「計算式による空...
-
【Excel】 csvの作成時、空白セ...
-
形式貼り付けの「空白を無視す...
-
Excel:関数が入っているセルに...
-
リンク先が空白若しくはゼロの...
-
エクセルで上の行の値を自動的...
-
エクセルにて負の時間を0:00と...
-
エクセルのグラフで式や文字列...
おすすめ情報
t_fumiakiさん。おっしゃる通りです。発注書に残るのは1番目と最後のデータです。元々期間として転記してたのかもしれません。ただ、発注書的には具合が悪いので3つある場合は3つとも転記出来ないかと思ってる次第です。転記先のセルは下段に空白セルが何段か余ってますので。。。コードをどう変えれば良いのかが分かりません。。。
t_fumiakiさん、ありがとうございます! 3つ目はF25、4つ目はF26…と1つずつ下へ行きます。
ちなみに下段の方の転記先もそれぞれ同列で1つずつ下へ行きます。どうでしょうか。。。