teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

追記

2020/03/25 19:53

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -3,4 +3,68 @@
3
3
  その時氏名の増減や、科目の増減にも対応したいですか?
4
4
  科目が増えたとき、同じ形の表を増やしますか?(列の増減はある?)
5
5
  各表の間に、空白行を挿入することは可能ですか?(これからずっと運用するにあたって)
6
- 表の中でA2、A10、A18は、結合されて無くて、空欄ですか?
6
+ 表の中でA2、A10、A18は、結合されて無くて、空欄ですか?
7
+
8
+ > 継続的に使いまわしたいです。
9
+ > 科目(列)や氏名が増えることはないと思いますので、そこは対応なくて構いません。
10
+ > 各表の間に空白行を挿入することは可能です!
11
+ > 列の整列の処理の後は、表の部分は削除する処理を入れようと考えておりました。
12
+ >
13
+ > A2~は空欄です。整列後の1行目には「日付」「科目」‥‥自動で入るようにしたいと思っています。
14
+
15
+ ---
16
+
17
+ 遅くなりました。
18
+ 表の間に1行空白行が入っているものとします。
19
+ ```ExcelVBA
20
+ Sub test()
21
+ Dim rngTarget As Range
22
+ Dim rngData As Range
23
+ Dim rngResults As Range
24
+ Dim a As Range
25
+ Dim c As Range
26
+ Dim ixRow As Long
27
+ Dim rngItemV As Range
28
+ Dim rngItemH As Range
29
+
30
+ Set rngTarget = ActiveSheet.Range("A:F").SpecialCells(xlCellTypeConstants)
31
+ Set rngResults = ActiveSheet.Range("I1")
32
+ ixRow = 1
33
+
34
+ rngResults(ixRow, 1).Resize(, 5).Value = Split("日付,科目,点数,氏名,備考", ",")
35
+
36
+ For Each a In rngTarget.Areas
37
+ With a
38
+ Set rngData = .Resize(.Rows.Count - 3, .Columns.Count - 1).Offset(2, 1)
39
+ End With
40
+
41
+ For Each c In rngData.Cells
42
+ Set rngItemH = Intersect(rngData, c.EntireRow)
43
+ Set rngItemV = Intersect(rngData, c.EntireColumn)
44
+
45
+ ixRow = ixRow + 1
46
+ rngResults(ixRow, 1).Value = rngItemV(-1, 1).Value
47
+ rngResults(ixRow, 2).Value = rngItemV(0, 1).Value
48
+ rngResults(ixRow, 3).Value = c.Value
49
+ rngResults(ixRow, 4).Value = rngItemH(1, 0).Value
50
+ rngResults(ixRow, 5).Value = rngItemV(6, 1).Value
51
+ Next
52
+ Next
53
+ End Sub
54
+
55
+ ```
56
+
57
+ ごめんなさい。
58
+ 動作確認してません。
59
+ こんな感じとかで出来ると思いますが、
60
+ 分かりますでしょうか?
61
+ 解らないところは聞いて下さい。
62
+ (あまり時間が取れないので返事が遅くなります。)
63
+
64
+ 他の方の回答が付きませんね。
65
+ 質問が丸投げになっているので、敬遠されているかもです。
66
+ (僕が変な回答をしたせいかも?)
67
+ いずれにしても、わからないなりに、どんなことをしてみたけど、
68
+ 上手く行かなかったということを説明して、
69
+ やりとりしながら、解決の方向を目指してください。
70
+ いまから勉強していくのですから、一朝一夕で解決するとは思わない方がよいです。