Excelについての質問です。現在、とある資料を写真のようになるよう、VBAでプログラムを作成したいのですが、ほぼ初心者で調べても中々分からずに苦戦しています。プログラムと簡単な説明をお願いし

Excelについての質問です。現在、とある資料を写真のようになるよう、VBAでプログラムを作成したいのですが、ほぼ初心者で調べても中々分からずに苦戦しています。プログラムと簡単な説明をお願いし たいです。 写真の説明が難しいで大体察して貰えると助かります… A列の行幅と太枠の行数は不規則です。

画像

Excel | Visual Basic41閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

1

そんなけったいな表(左側の)を使っていると、「そんな不便な表は作り変えろ警察」が来ますよ…。 それに右側の表、おかしくないですか? 部署Xが3/1に会議と開発の両方、部署Yが3/2に会議と開発の両方をやってますけども…。 A列に商品名以外にも複数入力があるので、「セルの上端が罫線〜次の罫線の間で最初に見つかった物を商品名」とします。 Sub test() Dim i As Long, j As Long, s As Long, y As Long Dim sh1 As Worksheet, sh2 As Worksheet '左側の表があるシートを指定 Set sh1 = Sheets("Sheet1") 'まとめ用シートを作成 Set sh2 = Sheets.Add(After:=Sheets("Sheet1")) sh2.Range("A1") = "商品名" sh2.Range("B1") = "部署" sh2.Range("C1") = "日付" sh2.Range("D1") = "予定" For i = 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row If sh1.Cells(i, 1).Borders(xlEdgeTop).LineStyle <> -4142 Then '最初の入力が商品名 For s = i To sh1.Cells(Rows.Count, 1).End(xlUp).Row If sh1.Cells(s, 1) <> "" Then Exit For Next s '次の商品名の行番号を取得 For y = s + 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row If sh1.Cells(y, 1).Borders(xlEdgeTop).LineStyle <> -4142 Then Exit For Next y For j = s To y - 1 '1日(C列の行番号は3)C列に入力があれば転記 If sh1.Cells(j, 2) <> "" And sh1.Cells(j, 3) <> "" Then With sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'AB列 .Value = sh1.Cells(s, 1) .Offset(, 1).Value = sh1.Cells(j, 2) 'C列-->C:D列 .Offset(, 2).Value = sh1.Cells(1, 3) .Offset(, 3).Value = sh1.Cells(j, 3) End With End If '2日(D列の行番号は4)D列に入力があれば転記 If sh1.Cells(j, 2) <> "" And sh1.Cells(j, 4) <> "" Then With sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'AB列 .Value = sh1.Cells(s, 1) .Offset(, 1).Value = sh1.Cells(j, 2) 'D列-->C:D .Offset(, 2).Value = sh1.Cells(1, 4) .Offset(, 3).Value = sh1.Cells(j, 4) End With End If Next j End If Next i sh2.Range("C:C").NumberFormatLocal = "m/d" End Sub 頭の体操になるかなと思って取り掛かってみましたが、予想以上に難航しました…頭がこんがらがってもうこれ以上考えたくないので、 アレンジの際は大体察して貰えると助かります(´・ω・)

1人がナイス!しています

写真右側の日付は自分のミスです!!(>_<) 左側のは簡易再現なので実際のはちょっと膨大すぎて直さないのかもですね… おぉ!!まさかここまでやって貰えるとは…!!明日プログラムの関数の意味と動きを考えながらやってみますね!!

ThanksImg質問者からのお礼コメント

まだ1人では理解出来てない所はありますが、上司に相談しながらアレンジして良い形が出来てきました。本当にありがとうございますm(*_ _)m

お礼日時:5/19 9:31