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

質問編集履歴

1

ソースコード追加

2017/03/10 06:41

投稿

hajimete
hajimete

スコア41

title CHANGED
File without changes
body CHANGED
@@ -20,7 +20,111 @@
20
20
  F列にB列のランダムな数字を整列して順番に上から並んでいます。
21
21
 
22
22
  L列には本文にアンカーといわれるものがついています。
23
+ """""
24
+
25
+ '「reg_date」の値を基に昇順に並び替える
26
+ Finr = .Range("B1").End(xlDown).Row
27
+ .Range("A1" & ":AD" & Finr).Sort Key1:=.Range("X1"), order1:=xlAscending, Header:=lYes
28
+
29
+
30
+ '列を挿入する
31
+ .Columns("F").Insert
32
+
33
+ '挿入した列に「=row()-2」を代入
34
+ .Range("F3" & ":F" & Finr).Value = "=row()-2"
35
+
36
+ '1行目(各項目名)をSheet2にコピー
37
+ Worksheets("Sheet1").Select
38
+ .Range("A1:AE1").Select
39
+ Selection.Copy
40
+ Worksheets("Sheet2").Select
41
+ Worksheets("Sheet2").Range("A1").Select
42
+ ActiveSheet.Paste
43
+
44
+
45
+ '「res_count」列の1行目以降に数値が入っているセルを検索し、入っている行を切り取りSheet2にペースト(次スレ以降のタイトル行を削除)
46
+ DelY = 1
47
+
48
+ For i = 1 To R
23
49
 
50
+ If Not .Range("O" & DelY & ":O" & Finr).Find(What:="*", LookIn:=xlValues) Is Nothing Then
51
+
52
+ DelY = .Range("A" & DelY & ":A" & Finr).Find(What:="*", LookIn:=xlValues).Row
53
+
54
+ If Len(Trim(DelY)) <> 0 Then
55
+
56
+ Worksheets("Sheet1").Select
57
+ .Range("A" & DelY & ":AE" & DelY).Select
58
+ Selection.Copy
59
+
60
+
61
+ Worksheets("Sheet2").Select
62
+ Worksheets("Sheet2").Range("A" & (i + 1)).Select
63
+ ActiveSheet.Paste
64
+
65
+ Worksheets("Sheet1").Select
66
+ .Range("A" & DelY).Select
67
+
68
+ If DelY <> 2 Then
69
+
70
+ Selection.EntireRow.Delete
71
+ DelY = DelY - 1
72
+
73
+ Else
74
+
75
+ .Range("A2").ClearContents
76
+
77
+ End If
78
+
79
+
80
+ End If
81
+
82
+
83
+ End If
84
+
85
+ Next i
86
+
87
+ .Range("A2").Value = "1"
88
+
89
+ Worksheets("Sheet2").Select
90
+ Columns("F").Select
91
+ Selection.Delete
92
+ Range("A1").Select
93
+
94
+ Worksheets("Sheet1").Select
95
+
96
+
97
+ '「status」列に「1」以外の数字が入っている場合は行ごと削除
98
+ i = 2
99
+ Do While i < Finr
100
+
101
+ If i <= 1 Then
102
+
103
+ MsgBox "タイトル行(スレッドタイトル、本文)が削除されています!OPEでスレッドタイトル、本文が削除されていないか確認し、データダウンロードからやり直してください"
104
+ Cells.Clear
105
+ Exit Sub
106
+
107
+ End If
108
+
109
+ Serc = .Range("R" & i).Value
110
+
111
+ If Serc = "1" Then
112
+
113
+ i = i + 1
114
+
115
+ ElseIf Serc = "" Then
116
+
117
+ Exit Do
118
+
119
+ Else
120
+
121
+ .Rows(i).Delete
122
+ i = i - 1
123
+
124
+ End If
125
+
126
+ Loop
127
+ """""
24
128
  結果
25
129
  L列に入ってるアンカーをC列で修正された数字に置換する
26
130