[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『転記』（ゆう）
どなたかご教授願います。
シート1売上データからシート2に転記する時のコードに困っております。
シート2の一定行にあらかじめ、文字が記入されております。
売上データ1を、シート2の一定行を飛ばして転記したいです。
例えば、シート1がA1~E10の売上データをシート2の6、7、8行目と13、14、15行目を飛ばして、丸々転記する場合のコードはどうなるでしょうか？
何卒、宜しくお願いします。
＜ 使用 Excel：Excel2016mac、使用 OS：MacOSX ＞
シート1のA1〜E5をコピーして シート2のA1に貼付 シート1のA6〜E9をコピーして シート2のA9に貼付 シート1のA10〜E10をコピーして シート2のA16に貼付
（もこな２ ） 2020/07/25(土) 23:13
Sub さんぷる()
Stop 'ブレークポイントの代わり
Dim 出力行 As Long
Dim データ行 As Long
出力行 = 1
データ行 = 1
Do Until データ行 > 10
Select Case 出力行
Case 6, 7, 8, 13, 14, 15
Stop
Case Else
Stop
Worksheets("シート１").Range("A1:E10").Rows(データ行).Copy Worksheets("シート２").Cells(出力行, "A")
データ行 = データ行 + 1
End Select
出力行 = 出力行 + 1
Loop
End Sub
（もこな２ ） 2020/07/25(土) 23:46
丁寧にご説明して下さり、ありがとうございました！
すみません、少し説明不足でした。
シート1は毎日売上データが更新されます。
例
C D E
8 SS20 7/1 1 1600
9 7/2 2 3000
10 7/3 1 700
11 7/4
12 7/5
13 7/6
14 SS20 集計
15 FW20 7/1
16 7/2
17 7/3
上記のように次の日に14行目にその日のSS20の売上データが入り、15行目にあるFW20の7/1分データが16行目に移るようになっております。このDEの個数と価格のデータを転記したいです。
そしてデータを移したいシート2は
A B C D E
1 thu
2 fri
3 sat
4 sun
5 weekly budget
6 weekly total
7 weekly ~
8 mon
9 tue
10 wed
上記のような5,6,7行目にあらかじめ項目が入っており、この3行を飛ばして、DE部分に、シート1の売上データを転記したいです。
更に、シート1の初めと終わりの行が日々1個づつずれていくFW20のデータも別シートにある“シート2と同じフォーム”に転記したいです。分かりづらい説明ですみません。VBA初心者なのでご教授していただきたいです。宜しくお願いします。
（ゆう） 2020/07/26(日) 11:53
【シート1】
___C_____D_____E______F___ 7 項目 日付 個数 価格 8 SS20 7/1 1 1600 9 SS20 7/2 2 3000 10 SS20 7/3 1 700 11 SS20 7/4 12 SS20 7/5 13 SS20 7/6 14 SS20 集計 15 FW20 7/1 16 FW20 7/2 17 FW20 7/3
ただ、こちらだと
＞上記のように次の日に14行目にその日のSS20の売上データが入り
「次の日」というのがよくわかりません。
さらに、「14行目」に限らず”その日”のデータは対応する日付の部分にはいりませんか？
＞15行目にあるFW20の7/1分データが16行目に移るようになっております。
なんのこっちゃかわかりません。
シート２のほうも↓のような感じかと思いますが、どうなれば正解なのでしょうか？
【シート２】
_______A____________ 1 thu 2 fri 3 sat 4 sun 5 weekly budget 6 weekly total 7 weekly 〜 8 mon 9 tue 10 wed
＞VBA初心者なのでご教授していただきたいです。
繰り返しになりますが、現状だとわからない部分がわかりません。
考えているアプローチが知りたいので、完成してなくてよいので現状のコードを見せていただけませんか？
（無理にとは言いませんが・・・・）
（もこな２ ） 2020/07/26(日) 13:27
説明が分かりづらくすみませんでした。
＞上記のように次の日に14行目にその日のSS20の売上データが入り
「次の日」というのがよくわかりません。
さらに、「14行目」に限らず”その日”のデータは対応する日付の部分にはいりませんか？
シート1はデータを更新すると当日のデータが入るような仕組みになっております。もこな2さんに作っていただいた表ですと、14行目に7/7日分のデータが入ります。そして16行目にFW20の7/1日分が移動します。更新をかけるごとに日付とデータが増えていくようになっております。
シート2はもこな2さんが作り直していただいたもので合っております。
VBAをオンライン講座で１０時間ほど勉強したばかりで、どんなコードを書いていいかさえ分からない状態です。お恥ずかしい話ですが、見本コードなど書いていただけると大変助かります。何卒、宜しくお願いします。
（ゆう） 2020/07/26(日) 14:33
作成依頼ではなく質問だとすると、「シート1はデータを更新すると当日のデータが入るような仕組みになっております。」とのことですが、それはどうやって実現しているのでしょうか？
そこをマクロでやっているなら、そのコードを提示していただくと、回答者側で状況を把握するヒントになるかもしれません。
このほか、「シート2はもこな2さんが作り直していただいたもので合っております。」とのことですが、こちらも繰り返しになりますが【どうなれば正解】なのでしょうか？
(想像するに、曜日ごとの計が分かればよいようにも思いますが、何も提示されてないのでわかりません）
（もこな２ ） 2020/07/26(日) 17:58
閲覧しての感想を、横から失礼します。
まず、シート2にどういう結果を得たいかを示されていないので、 まだ質問が終わっていない状態です。 シート1の情報をもとに、どういう結果を得たいか きちんと書いてください。
以下は余談です。 # なお、シートの設計がまずいような気がします。 # シート1は横方向に商品を展開して、 # 縦に日付を配置すれば、 # データの挿入によって、他の商品に影響を与えることが避けられます。 # しなくて良い苦労をしているような気がします。
（γ） 2020/07/26(日) 18:22
お返事遅れて申し訳ございません。
作成依頼では決してないのですが、甘え過ぎました。
大変申し訳ございませんでした。
自分なりに調べて分かるところまでコードを書きました。
ご教授いただきたいです。
何卒、よろしくお願いいたします。
@(r)さん
助言ありがとうございました。
前任者から引き継いだばかりの仕事で改善点が沢山あります。
少しづつ改善していきたいと思います。
まずはシート１を変更させてください。
毎日BMSという売上集計のシステムからExcelをエクスポートしたものです。
ですので最終行が常に増えていきます。
【シート1】
___C_____D_____E______F___ 7 店舗 日付 個数 価格 8 表参道 7/1 1 1600 9 新宿 7/1 2 3000 10 表参道 7/2 1 700 11 表参道 7/2 12 池袋 7/2 13 新宿 7/3
【シート２】
___A____B___C____ __________表参道______新宿____ ________個数__売上___個数__売上
1 thu 2 fri 3 sat 4 sun 5 weekly budget 6 weekly total 7 weekly 〜 8 mon 9 tue 10 wed
シート１から日ごとの売上合計と合計個数を、シート２のB,Cに店ごとに転記したいです。ただしシート２の5,6,7行目は週の合計などが入るので、そこには転記をしたくありません。
下記が自分が書いたコードです。
sales(2020 July)BMSがシート１
第21期売上一覧がシート２
MC TOKYO OMOTESANDOが表参道です。
とりあえず表参道分だけコードを書きました。
すみません。worksheet のrangeの後のコードも分からないので途中です。
Sub SalesReport()
'To get a Title Row
Dim r As Integer
r = Worksheets("第21期売上一覧").Range("E3").Row
'To Transfer Date
Dim LastRow As Long, LastRow_2 As Long
LastRow = Worksheets("sales(2020 July)BMS").Cells(Rows.Count, 12).End(xlUp).Row
LastRow_2 = Worksheets("sales(2020 July)BMS").Cells(Rows.Count, 31).End(xlUp).Row
Dim i As Long
For i = 6 To LastRow
If Worksheets("sales(2020 July)BMS").Range("L" & i).Value = "MC TOKYO OMOTESANDO" Then
r = r + 1
' Sum Cost
Ans = WorksheetFunction.SumIf(Range("L2 : LastRow"), "MC TOKYO OMOTESANDO", ("AE6 : LastRow_2"))
Worksheets("第21期売上一覧").Range("E" & "i").Value = _
Worksheets("sales(2020 July)BMS").Range
' Sum Quantitiy
Ans = WorksheetFunction.SumIf(Range("L2 : LastRow"), "MC TOKYO OMOTESANDO", ("AI6 : LastRow_2"))
Worksheets("第21期売上一覧").Range"D" & "i").Value = _
Worksheets("sales(2020 July)BMS").Range
End If
End Sub
（ゆう） 2020/07/28(火) 19:01
こんばんは！ あたし風にちょっと書いてみました。 Sheet1のC列から↓こんな表があったとして
_____C___________D______E_______F
[7] 店舗 日付 個数 価格 [8] 表参道 7月1日 1 1600 [9] 新宿 7月1日 2 3000 [10] 表参道 7月2日 1 700 [11] 表参道 7月2日 3 800 [12] 池袋 7月2日 2 650 [13] 新宿 7月3日 2 750 [14] 表参道 7月5日 4 600
Sheet2 のA1から↓こんな感じで書き出します。 表参道 新宿 池袋 個数 売上 個数 売上 個数 売上 thu 4 1500 2 650 fri 2 750 sat sun 4 600
mon tue wed 1 1600 2 3000
あってますかぁ？？？？ 書きっぱなしなので良かったら応用してください。。。 では、、、では、、、
Option Explicit
Sub てすと()
Dim v As Variant
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim i As Long
Dim MyWeek As Long
x = Application.Transpose(Array("", "", "thu", "fri", "sat", "sun"))
y = Application.Transpose(Array("mon", "tue", "wed"))
With Sheets("Sheet1")
v = .Range("C7", .Range("C" & Rows.Count).End(xlUp)).Resize(, 4).Value
End With
For i = LBound(v, 1) + 1 To UBound(v, 1)
z = Application.Match(v(i, 1), Application.Index(x, 1, 0), 0)
If IsError(z) Then
ReDim Preserve x(LBound(x, 1) To UBound(x, 1), LBound(x, 2) To UBound(x, 2) + 2)
x(1, UBound(x, 2) - 1) = v(i, 1)
x(2, UBound(x, 2) - 1) = "個数"
x(2, UBound(x, 2)) = "売上"
ReDim Preserve y(LBound(y, 1) To UBound(y, 1), LBound(y, 2) To UBound(y, 2) + 2)
End If
Next
For i = LBound(v, 1) + 1 To UBound(v, 1)
MyWeek = Weekday(v(i, 2), vbThursday)
z = Application.Match(v(i, 1), Application.Index(x, 1, 0), 0)
If Not IsError(z) Then
If MyWeek >= 5 Then
MyWeek = MyWeek - 4
y(MyWeek, z) = y(MyWeek, z) + v(i, 3)
y(MyWeek, z + 1) = y(MyWeek, z + 1) + v(i, 4)
Else
MyWeek = MyWeek + 2
x(MyWeek, z) = x(MyWeek, z) + v(i, 3)
x(MyWeek, z + 1) = x(MyWeek, z + 1) + v(i, 4)
End If
End If
Next
With Sheets("Sheet2")
.Cells.Clear
.Range("A1").Resize(UBound(x, 1), UBound(x, 2)).Value = x
.Range("A10").Resize(UBound(y, 1), UBound(y, 2)).Value = y
End With
Erase v, x, y
End Sub
（SoulMan） 2020/07/28(火) 20:53
本当にありがとうございました！
今の自分には難しすぎて理解できません泣
全部理解できるよう調べてみようと思います！
（ゆう） 2020/07/28(火) 23:30
___C________D______E_______F___ 7 店舗 日付 個数 価格 8 表参道 7/1 1 1600 9 新宿 7/1 2 3000 10 表参道 7/2 1 700 11 表参道 7/2 12 池袋 7/2 13 新宿 7/3
【第21期売上一覧】
______A__________B______C_________D______E____ 1 * 表参道 ** *** 新宿 ** 2 個数 売上 個数 売上 3 thu 4 fri 5 sat 6 sun 7 weekly budget 8 weekly total 9 weekly 〜 10 mon 11 tue 12 wed
そのうえで、シート２が【どうなれば正解】なのか提示されてないので、マクロでやりたいことが私にはわかりませんでした。
ただ、表を見ると、店舗ごと・曜日ごとに個数と売上を集計したいのではありませんか？
それなら、マクロでなく数式でも対応できるような気がします。
（もこな２ ） 2020/07/29(水) 08:01
返信ありがとうございます！
上記のマクロが難し過ぎて、理解に時間がかかりそうです。
もう少し初心者でも理解できるようなコードはあるのでしょう？
もこな２さんの意見も聞きたいです。
よろしくお願いします。
（ゆう） 2020/07/29(水) 09:40
'Sheet1のC7=「店舗」のレイアウトが前提
Dim 個数 As Object, 価格 As Object, 列 As Object, c As Range, k As Variant, col As Long
Sheets("Sheet2").Cells.Clear
Set 個数 = CreateObject("Scripting.Dictionary")
Set 価格 = CreateObject("Scripting.Dictionary")
Set 列 = CreateObject("Scripting.Dictionary")
For Each c In Sheets("Sheet1").Range("C8:C" & Rows.Count).SpecialCells(2)
個数(c.Value & Chr(2) & Weekday(c.Offset(, 1))) = 個数(c.Value & Chr(2) & Weekday(c.Offset(, 1))) + c.Offset(, 2).Value
価格(c.Value & Chr(2) & Weekday(c.Offset(, 1))) = 価格(c.Value & Chr(2) & Weekday(c.Offset(, 1))) + c.Offset(, 3).Value
If Not 列.exists(c.Value) Then 列(c.Value) = (列.Count + 1) * 2
Next c
For Each k In 個数
col = 列(WorksheetFunction.Clean(Left(k, InStr(k, Chr(2)))))
Sheets("Sheet2").Cells(1, col).Resize(2, 2).Value = _
Application.Transpose(Array(Array(WorksheetFunction.Clean(Left(k, InStr(k, Chr(2)))), "個数"), Array("", "価格")))
Sheets("Sheet2").Range("A" & Right(k, 1)).Value = WeekdayName(Right(k, 1))
Sheets("Sheet2").Range("A" & Right(k, 1)).Offset(, col - 1).Resize(, 2).Value = Array(個数(k), 価格(k))
Next k
End Sub
（mm） 2020/07/29(水) 10:52
（もこな２） 2020/07/29(水) 12:58
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.