Excel表について（2）

（1）の質問に続き、この形の表に変換することは可能でしょうか？

赤線は1画面にはいりきらないため、省略の意味を込めて書いています。

質問者からの補足コメント

• 

  ご回答ありがとうございます！
  
  表が見づらくて申し訳ないです。
  
  りんごの中にも種類があって、それを黒字と赤字で分けております。
  
  作業列という考えは無かったので、頑張って調べてみます！

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/01/17 21:16

• 

  ご回答ありがとうございます！
  
  これは単純に私の記載ミスです。
  おっしゃるとおり、4行目から12行目にも日付を設定しないといけないですね。
  1月2日以降も同様の認識でおねがいいたします。
  
  また、他の方からのご指摘もありましたが表（1）も見づらくてすみません。
  
  またご不明な点がございましたら補足いたします！

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/01/17 21:21

• 

  質問1で断念補足をしたのですが、こちらのご回答を見逃しておりました。
  
  ご指摘の通りです！
  不明点1と2両方あっております！

  No.4の回答に寄せられた補足コメントです。 補足日時：2024/01/22 19:40

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/01/22 21:35

以下のマクロを標準モジュールに登録してください。

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

使用上の注意
１．Sheet1の種別の数と最終列の関係は以下のようになっています。
以下の条件が成立しない場合、”最終列数不正”のエラーメッセージが表示されます。
種別の数　最終列
1　　　　M列
2　　　　T列
3　　　　AA列
4　　　　AH列
5　　　　AO列
6　　　　AV列
7　　　　BC列
8　　　　BJ列
9　　　　BQ列
10　　　　BX列

２．Sheet1の日付と最終行の関係は以下のようになっています。
B列の日付は結合セルのため、”1月31日”等の日付が格納されるセルは上側になります。
従って、最後の日付（通常は月末の日付）が、６以上の偶数行でない場合、”最終行数不正”のエラーメッセージが表示されます。

３．Sheet1の種別は結合セルのため、上部の最も左側のセルが対象になります。
種別を取得するセルの値は
1番目の種別＝E3
2番目の種別＝L3
3番目の種別＝S3
4番目の種別＝Z3
のようになります。

４．空のSheet2を作成しておいてください。

以上、不明点があれば補足してください。

この回答へのお礼

できました！！！本当にありがとうございます！
こちらをお手本にVBAの勉強がんばります!
長らくお付き合い頂きありがとうございました！

お礼日時：2024/01/23 20:02

No.4 回答者： tatsumaru77 回答日時： 2024/01/19 18:44

追加の補足要求です。

Excel表について（1）
https://oshiete.goo.ne.jp/qa/13710131.html
の、No4,No5で補足要求をしましたが、補足がありませんでした。

画像が不鮮明なので、こちらで想像で、Sheet1のレイアウトを添付図のように仮定しました。
（上部がSheet1、下部がSheet2です）

不明点１．
Sheet1の1月1日のリンゴと桃のデータの位置は、下記であってますか。
リンゴ　①＝I6
リンゴ　②＝I7
桃　　　③＝P6
桃　　　④＝P7

不明点２．
Sheet2へ出力時、赤字で出力するのは、②、④であってますか。

No.3 回答者： kanta2006 回答日時： 2024/01/18 00:19

＞りんごの中にも種類があって、それを黒字と赤字 で分けております。

ということなのですが、その種類分けは色だけで分けてるんですか？
それとも条件付き書式で文字に色を付けてるんですか？

もし、色だけでりんごの種類を分けていて、その文字色を判定しなければならないとしたら、なんか面倒そうだなと思ってしまいました。

質問の答えになってないかもしれませんが、全体的に集計しにくそうな表だなぁ。という印象があります。
集計の方法を考える前に、集計しやすいように表のフォーマットを見直したほうがいいような気がしますね。

No.2 回答者： tatsumaru77 回答日時： 2024/01/17 20:38

補足要求です。

日付にフィルターが設定されていますが、実際のが記入されているのは、
1月１日を例にとると、３行目のみです。（B4:B12が空白です）
この状態で、フィルターで１月１日を設定すると３行目のみが表示されます。
（４行目～１２行目は、１月１日のデータであるにも関わらず、表示されません。）
４行目～１２行目も表示するには、４行目～１２行目にも１月１日の日付を設定しないといけませんが、
このままで宜しいのでしょうか。
B4:B12に１月１日を設定すべきと考えますが、いかがでしょうか。
１月２日以降も同様です。

No.1 回答者： banzaiA 回答日時： 2024/01/17 16:09

可能でしょう。

ただExcel表について（1）の表が見づらくて、また赤字の部分、
リンゴ　2は黒字でリンゴ　0　は赤字の意味がわからない。
直接（1）から（2）へは無理なら、作業列を作ってから変換表にすればできるでしょう。