No.5ベストアンサー
- 回答日時:
以下のマクロを標準モジュールに登録してください。
Option Explicit
Public Sub 項目転記()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim maxrow1 As Long 'Sheet1 最大行数
Dim maxcol1 As Long 'Sheet1 最大列数
Dim kcount As Long '種別の数
Dim kno As Long '種別の番号
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Dim row2_st As Long
Dim sum As Variant
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
maxrow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
maxcol1 = ws1.Cells(5, Columns.Count).End(xlToLeft).Column
kcount = get_kcount(maxcol1)
If kcount < 1 Then
MsgBox ("最終列数不正")
Exit Sub
End If
If maxrow1 < 6 Or maxrow1 Mod 2 <> 0 Then
MsgBox ("最終行数不正")
Exit Sub
End If
'Sheet2クリア
ws2.Cells.Clear
ws2.Cells(2, "B").Value = "日付"
ws2.Cells(2, "C").Value = "種別"
ws2.Cells(2, "D").Value = "仕掛"
Call set_lines(ws2.Range("B2:D2")) '罫線
row2 = 3
'1日~末日まで繰り返す
For row1 = 6 To maxrow1 Step 2
'種別の数分繰り返す
sum = 0
row2_st = row2
For kno = 1 To kcount
col1 = (kno - 1) * 7 + 2 '該当種別列のオフセット
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "B").Value '日付
ws2.Cells(row2, "C").Value = ws1.Cells(3, col1 + 3).Value '種別
ws2.Cells(row2, "D").Value = ws1.Cells(row1, col1 + 7).Value '仕掛
ws2.Cells(row2 + 1, "B").Value = ws1.Cells(row1, "B").Value '日付
ws2.Cells(row2 + 1, "C").Value = ws1.Cells(3, col1 + 3).Value '種別
ws2.Cells(row2 + 1, "D").Value = ws1.Cells(row1 + 1, col1 + 7).Value '仕掛
ws2.Cells(row2 + 1, "D").Font.Color = -16776961 '赤字設定
sum = sum + ws2.Cells(row2, "D").Value + ws2.Cells(row2 + 1, "D").Value
row2 = row2 + 2
Next
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "B").Value '日付
ws2.Cells(row2, "C").Value = "総仕掛"
ws2.Cells(row2, "D").Value = sum
Call set_lines(ws2.Range("B" & row2_st & ":D" & row2)) '罫線
row2 = row2 + 2
Next
ws2.Columns("B:D").AutoFilter
MsgBox ("完了")
End Sub
'最終列から種別の数を算出する
Private Function get_kcount(ByVal ecol As Long) As Long
get_kcount = -1
If ecol < 13 Then Exit Function
If (ecol - 4 - 2) Mod 7 <> 0 Then Exit Function
get_kcount = (ecol - 4 - 2) \ 7
End Function
'指定範囲に罫線を設定する
Private Sub set_lines(ByVal rng As Range)
rng.Borders(xlEdgeTop).LineStyle = xlContinuous
rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
rng.Borders(xlEdgeRight).LineStyle = xlContinuous
rng.Borders(xlInsideVertical).LineStyle = xlContinuous
rng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End Sub
使用上の注意
1.Sheet1の種別の数と最終列の関係は以下のようになっています。
以下の条件が成立しない場合、”最終列数不正”のエラーメッセージが表示されます。
種別の数 最終列
1 M列
2 T列
3 AA列
4 AH列
5 AO列
6 AV列
7 BC列
8 BJ列
9 BQ列
10 BX列
2.Sheet1の日付と最終行の関係は以下のようになっています。
B列の日付は結合セルのため、”1月31日”等の日付が格納されるセルは上側になります。
従って、最後の日付(通常は月末の日付)が、6以上の偶数行でない場合、”最終行数不正”のエラーメッセージが表示されます。
3.Sheet1の種別は結合セルのため、上部の最も左側のセルが対象になります。
種別を取得するセルの値は
1番目の種別=E3
2番目の種別=L3
3番目の種別=S3
4番目の種別=Z3
のようになります。
4.空のSheet2を作成しておいてください。
以上、不明点があれば補足してください。
できました!!!本当にありがとうございます!
こちらをお手本にVBAの勉強がんばります!
長らくお付き合い頂きありがとうございました!
No.4
- 回答日時:
追加の補足要求です。
Excel表について(1)
https://oshiete.goo.ne.jp/qa/13710131.html
の、No4,No5で補足要求をしましたが、補足がありませんでした。
画像が不鮮明なので、こちらで想像で、Sheet1のレイアウトを添付図のように仮定しました。
(上部がSheet1、下部がSheet2です)
不明点1.
Sheet1の1月1日のリンゴと桃のデータの位置は、下記であってますか。
リンゴ ①=I6
リンゴ ②=I7
桃 ③=P6
桃 ④=P7
不明点2.
Sheet2へ出力時、赤字で出力するのは、②、④であってますか。
No.3
- 回答日時:
>りんごの中にも種類があって、それを黒字と赤字 で分けております。
ということなのですが、その種類分けは色だけで分けてるんですか?
それとも条件付き書式で文字に色を付けてるんですか?
もし、色だけでりんごの種類を分けていて、その文字色を判定しなければならないとしたら、なんか面倒そうだなと思ってしまいました。
質問の答えになってないかもしれませんが、全体的に集計しにくそうな表だなぁ。という印象があります。
集計の方法を考える前に、集計しやすいように表のフォーマットを見直したほうがいいような気がしますね。
No.2
- 回答日時:
補足要求です。
日付にフィルターが設定されていますが、実際のが記入されているのは、
1月1日を例にとると、3行目のみです。(B4:B12が空白です)
この状態で、フィルターで1月1日を設定すると3行目のみが表示されます。
(4行目~12行目は、1月1日のデータであるにも関わらず、表示されません。)
4行目~12行目も表示するには、4行目~12行目にも1月1日の日付を設定しないといけませんが、
このままで宜しいのでしょうか。
B4:B12に1月1日を設定すべきと考えますが、いかがでしょうか。
1月2日以降も同様です。
No.1
- 回答日時:
可能でしょう。
ただExcel表について(1)の表が見づらくて、また赤字の部分、
リンゴ 2は黒字でリンゴ 0 は赤字の意味がわからない。
直接(1)から(2)へは無理なら、作業列を作ってから変換表にすればできるでしょう。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 英語 if の省略 6 2022/02/02 14:24
- Excel(エクセル) Excelマクロの表示のExcel内をfindで検索 3 2022/06/15 20:07
- 英語 提示した名言の"be to be able to do"の意味等について 4 2023/05/17 10:02
- 数学 写真の問題についてですが、赤線部のところを見ると、「f'(x)=1/xは…」と書かれているのですが、 3 2023/02/08 15:48
- 数学 写真の問題についてですが、赤線部のところを見ると、「f'(x)=1/xは…」と書かれているのですが、 5 2023/02/08 15:49
- 日本語 「試験に合格するには、努力が必要だ」という文の「に」の用法について教えてください。 18 2023/05/28 15:57
- 数学 3次元実ベクトル空間において, 平面 P:x-y+z+1=0 と直線 L:2(x-1)=-y=-z 3 2022/10/29 14:39
- PDF Word→pdfに変換する際,図形部分に画像が上書きされる 1 2023/02/01 12:49
- 日本語 https://eprints.lib.hokudai.ac.jp/dspace/bitstream 6 2022/05/22 18:54
- 数学 線形代数の問題です。わかる方回答よろしくお願いいたします。問題は、線形変換f:R^3→R^3が、写真 3 2023/10/28 12:19
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
Excel表について(1)
Excel(エクセル)
-
エクセルで⑤番の操作が分かりません。どういう関数が良いんですか?
Excel(エクセル)
-
数値から名前が作成できなくなっているッ!?
Excel(エクセル)
-
-
4
Excel関数かなにかでスムーズに処理するにはあなたならどうしますか?
Excel(エクセル)
-
5
エクセルの表の参照値から円を取って数字で扱えるようにしたい
Excel(エクセル)
-
6
エクセルの関数でわからないことあるのでコード付きで教えてください
Excel(エクセル)
-
7
Excelでこういう年を切り替えられる簡易なカレンダーを作ったのですが、 年や月を変えると、色が付い
Excel(エクセル)
-
8
当番表の作成について
Excel(エクセル)
-
9
エクセルで質問です。添付したように枠を設定する方法を教えて下さい
Excel(エクセル)
-
10
Excelの共有ファイルについて質問です。
Excel(エクセル)
-
11
エクセル2019のセル移動の速度?!について。
Excel(エクセル)
-
12
エクセルのcountifのワイルドカードについて
Excel(エクセル)
-
13
COUNTIFで同一範囲にある複数の内容の数量を簡単に抽出する方法を教えてください。
Excel(エクセル)
-
14
Excelの関数での合わせ方がわかりません!!!!!!!!
Excel(エクセル)
-
15
Excelの関数を教えてください。
Excel(エクセル)
-
16
勤務時間を割り出す、関数式を教えて頂きたいのですが、少し複雑で例えば項目名としてA1セルに出社時刻と
Excel(エクセル)
-
17
Excelの文字表示について
Excel(エクセル)
-
18
エクセルでの順番入れ替え
Excel(エクセル)
-
19
エクセルで相対パスの書き方を教えてください
Excel(エクセル)
-
20
ExcelでA列をコピーしたいのですがコピー範囲内に空白セルがあるとそこで終わってしまいます。 全て
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
緯度・経度の値をエクセルで変...
-
エクセル関数/10進法から60進法...
-
つらそう…を丁寧に言うなら、お...
-
PDFファイルのプロパティ内容削...
-
勝手に無変換になる
-
VB.NETで小数点以下の桁数を取...
-
アリーナ型議会と変換型議会の...
-
DMファイルをDXFかDWGに変換で...
-
Wordに囲い文字というのがない...
-
拡張子が「.Q4」の画像ファイル...
-
MP3を楽譜に変換するサイト、ア...
-
複数の写真をひとつのPDFにまと...
-
50Hzのシンクロナスモータを60H...
-
意外に?以外に??どちらが正...
-
DVDをmp4ファイルに変換
-
スクリーンショット:文字がぼ...
-
スプレッドシートから、スプレ...
-
miniSD変換アダプタ
-
文字変換の優先順位変更のやり方
-
DVD Flickで、長時間DVDさくせ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
緯度・経度の値をエクセルで変...
-
エクセル関数/10進法から60進法...
-
意外に?以外に??どちらが正...
-
アリーナ型議会と変換型議会の...
-
MP3を楽譜に変換するサイト、ア...
-
miniSD変換アダプタ
-
【Excel】数字を3倍にし、なお...
-
PDFファイルのプロパティ内容削...
-
VB.NETで小数点以下の桁数を取...
-
つらそう…を丁寧に言うなら、お...
-
クリスタでCMYKのデータを読み...
-
至急 情報Ⅰ スマホにはドメイン...
-
PNGファイルをSVGにロスなしで...
-
カーナビにスマホ画面を表示さ...
-
土日祝 の正しい読みは
-
Windows Media PlayerからMP3に...
-
ヘーホーメートルってどうやっ...
-
勝手に無変換になる
-
Wordに囲い文字というのがない...
-
単位の リューベ って
おすすめ情報
ご回答ありがとうございます!
表が見づらくて申し訳ないです。
りんごの中にも種類があって、それを黒字と赤字で分けております。
作業列という考えは無かったので、頑張って調べてみます!
ご回答ありがとうございます!
これは単純に私の記載ミスです。
おっしゃるとおり、4行目から12行目にも日付を設定しないといけないですね。
1月2日以降も同様の認識でおねがいいたします。
また、他の方からのご指摘もありましたが表(1)も見づらくてすみません。
またご不明な点がございましたら補足いたします!
質問1で断念補足をしたのですが、こちらのご回答を見逃しておりました。
ご指摘の通りです!
不明点1と2両方あっております!