このトピックに書きこむ |
---|
Re[2]: 表の列項目を追加挿入 | |
---|---|
[196206] Re[2]: 表の列項目を追加挿入- ■ ![]() □投稿者/ どん -(2024/05/04(10:07)) □U R L/ すごいです! ありがとうございました。 大変助かりました。 |
[196205] Re[1]: 表の列項目を追加挿入- ■記事引用/メール受信=OFF■ □投稿者/ 半平太 -(2024/05/04(08:37)) □U R L/ こんな感じかな? Sub test2() Dim BottomA As Range Dim ans, ret() Dim rName As Range, rData As Range, rdates As Range Dim dys As Long, i As Long, k As Long Dim fDay As Date ans = InputBox("例:2024/05", "年月を入力してください", Format(Date, "yyyy/mm")) If Not ans Like "####/##" Then Exit Sub Else fDay = DateSerial(Year(ans), Month(ans), 0) dys = Day(DateSerial(Year(ans), Month(ans) + 1, 0)) End If Set BottomA = Cells(Rows.Count, "A").End(xlUp) Set rName = Range("A1", BottomA) Set rData = Range("B1", BottomA.Offset(, dys)) ReDim ret(1 To BottomA.Row, 1 To dys * 3) For i = 1 To dys For k = 1 To BottomA.Row ret(k, i * 3 - 2) = rName(k, 1) '氏名 ret(k, i * 3 - 1) = IIf(k = 1, "日付", fDay + i) '日付 ret(k, i * 3) = rData(k, i) 'データ Next k Next i Range("A1").Resize(UBound(ret), UBound(ret, 2)) = ret Set rdates = Range("B2").Resize(BottomA.Row) For i = 2 To dys Set rdates = Union(rdates, Cells(2, i * 3 - 1).Resize(BottomA.Row - 1)) Next i rdates.NumberFormat = "m/d" Columns("A").Resize(, UBound(ret, 2)).EntireColumn.AutoFit End Sub |
[196203] 表の列項目を追加挿入- ■親トピック/記事引用/メール受信=OFF■ □投稿者/ どん -(2024/05/03(17:29)) □U R L/ 次の表なのですが、一番左に氏名があり、 その他項目がいくつかあるとして 氏名 日付(1ヶ月分) その他 を挿入したい。 −−−−−−−−−−−−−−−−−−−−−−−−−−―−−−−− 氏名 その他 その他 その他.... Aさん 〇 〇 × Bさん △ × △ Cさん ◇ △ 〇 Dさん □ □ □ ↓ ↓ ↓ 氏名 日付 その他 氏名 日付 その他 氏名 日付 その他 ..... Aさん 5/1 〇 Aさん 5/2 〇 Aさん 5/3 × Bさん 5/1 △ Bさん 5/2 × Bさん 5/3 △ Cさん 5/1 ◇ Cさん 5/2 △ Cさん 5/3 〇 Dさん 5/1 □ Dさん 5/2 □ Dさん 5/3 □ ご教示の程宜しくお願い致します。 ++++++++++++++++++++ OS ⇒OTHER Version⇒OTHER ++++++++++++++++++++ |