回答編集履歴

1

追記

2020/03/25 19:53

投稿

mattuwan
mattuwan

スコア2163

test CHANGED
@@ -9,3 +9,131 @@
9
9
  各表の間に、空白行を挿入することは可能ですか?(これからずっと運用するにあたって)
10
10
 
11
11
  表の中でA2、A10、A18は、結合されて無くて、空欄ですか?
12
+
13
+
14
+
15
+ > 継続的に使いまわしたいです。
16
+
17
+ > 科目(列)や氏名が増えることはないと思いますので、そこは対応なくて構いません。
18
+
19
+ > 各表の間に空白行を挿入することは可能です!
20
+
21
+ > 列の整列の処理の後は、表の部分は削除する処理を入れようと考えておりました。
22
+
23
+ >
24
+
25
+ > A2~は空欄です。整列後の1行目には「日付」「科目」‥‥自動で入るようにしたいと思っています。
26
+
27
+
28
+
29
+ ---
30
+
31
+
32
+
33
+ 遅くなりました。
34
+
35
+ 表の間に1行空白行が入っているものとします。
36
+
37
+ ```ExcelVBA
38
+
39
+ Sub test()
40
+
41
+ Dim rngTarget As Range
42
+
43
+ Dim rngData As Range
44
+
45
+ Dim rngResults As Range
46
+
47
+ Dim a As Range
48
+
49
+ Dim c As Range
50
+
51
+ Dim ixRow As Long
52
+
53
+ Dim rngItemV As Range
54
+
55
+ Dim rngItemH As Range
56
+
57
+
58
+
59
+ Set rngTarget = ActiveSheet.Range("A:F").SpecialCells(xlCellTypeConstants)
60
+
61
+ Set rngResults = ActiveSheet.Range("I1")
62
+
63
+ ixRow = 1
64
+
65
+
66
+
67
+ rngResults(ixRow, 1).Resize(, 5).Value = Split("日付,科目,点数,氏名,備考", ",")
68
+
69
+
70
+
71
+ For Each a In rngTarget.Areas
72
+
73
+ With a
74
+
75
+ Set rngData = .Resize(.Rows.Count - 3, .Columns.Count - 1).Offset(2, 1)
76
+
77
+ End With
78
+
79
+
80
+
81
+ For Each c In rngData.Cells
82
+
83
+ Set rngItemH = Intersect(rngData, c.EntireRow)
84
+
85
+ Set rngItemV = Intersect(rngData, c.EntireColumn)
86
+
87
+
88
+
89
+ ixRow = ixRow + 1
90
+
91
+ rngResults(ixRow, 1).Value = rngItemV(-1, 1).Value
92
+
93
+ rngResults(ixRow, 2).Value = rngItemV(0, 1).Value
94
+
95
+ rngResults(ixRow, 3).Value = c.Value
96
+
97
+ rngResults(ixRow, 4).Value = rngItemH(1, 0).Value
98
+
99
+ rngResults(ixRow, 5).Value = rngItemV(6, 1).Value
100
+
101
+ Next
102
+
103
+ Next
104
+
105
+ End Sub
106
+
107
+
108
+
109
+ ```
110
+
111
+
112
+
113
+ ごめんなさい。
114
+
115
+ 動作確認してません。
116
+
117
+ こんな感じとかで出来ると思いますが、
118
+
119
+ 分かりますでしょうか?
120
+
121
+ 解らないところは聞いて下さい。
122
+
123
+ (あまり時間が取れないので返事が遅くなります。)
124
+
125
+
126
+
127
+ 他の方の回答が付きませんね。
128
+
129
+ 質問が丸投げになっているので、敬遠されているかもです。
130
+
131
+ (僕が変な回答をしたせいかも?)
132
+
133
+ いずれにしても、わからないなりに、どんなことをしてみたけど、
134
+
135
+ 上手く行かなかったということを説明して、
136
+
137
+ やりとりしながら、解決の方向を目指してください。
138
+
139
+ いまから勉強していくのですから、一朝一夕で解決するとは思わない方がよいです。