アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

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

「Excel表について(2)」の質問画像

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

  • HAPPY

    ご回答ありがとうございます!

    表が見づらくて申し訳ないです。

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

    作業列という考えは無かったので、頑張って調べてみます!

    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

A 回答 (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を作成しておいてください。

以上、不明点があれば補足してください。
    • good
    • 0
この回答へのお礼

助かりました

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

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

追加の補足要求です。


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へ出力時、赤字で出力するのは、②、④であってますか。
「Excel表について(2)」の回答画像4
この回答への補足あり
    • good
    • 0

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



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

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

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

補足要求です。


日付にフィルターが設定されていますが、実際のが記入されているのは、
1月1日を例にとると、3行目のみです。(B4:B12が空白です)
この状態で、フィルターで1月1日を設定すると3行目のみが表示されます。
(4行目~12行目は、1月1日のデータであるにも関わらず、表示されません。)
4行目~12行目も表示するには、4行目~12行目にも1月1日の日付を設定しないといけませんが、
このままで宜しいのでしょうか。
B4:B12に1月1日を設定すべきと考えますが、いかがでしょうか。
1月2日以降も同様です。
この回答への補足あり
    • good
    • 0

可能でしょう。


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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A