質問編集履歴

4

2020/03/09 08:38

投稿

d_96a
d_96a

スコア15

test CHANGED
File without changes
test CHANGED
@@ -47,6 +47,12 @@
47
47
  下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されずフォルダも生成されない状態で処理が終了してしまいます。
48
48
 
49
49
  何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
50
+
51
+
52
+
53
+ 3/9再追記
54
+
55
+ セルに数式が入力されている状態だとうまくマクロが処理してくれないみたいで、数式を消すことでフォルダが正常に作成されました。
50
56
 
51
57
 
52
58
 

3

2020/03/09 08:38

投稿

d_96a
d_96a

スコア15

test CHANGED
File without changes
test CHANGED
@@ -44,7 +44,7 @@
44
44
 
45
45
  ###3/9追記
46
46
 
47
- 下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されること処理が終了してしまいます。
47
+ 下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されずフォルダも生成されい状態で処理が終了してしまいます。
48
48
 
49
49
  何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
50
50
 

2

2020/03/09 07:20

投稿

d_96a
d_96a

スコア15

test CHANGED
File without changes
test CHANGED
@@ -39,6 +39,14 @@
39
39
  VBAに関する知識が乏しく、調べても分からなかったため今回質問させていただきました。
40
40
 
41
41
  こちらのエラーを解決できる方がいらっしゃれば、ご回答をよろしくお願いします。
42
+
43
+
44
+
45
+ ###3/9追記
46
+
47
+ 下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されることなく処理が終了してしまいます。
48
+
49
+ 何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
42
50
 
43
51
 
44
52
 

1

2020/03/09 07:19

投稿

d_96a
d_96a

スコア15

test CHANGED
File without changes
test CHANGED
@@ -64,31 +64,31 @@
64
64
 
65
65
  Set fs = New Scripting.FileSystemObject
66
66
 
67
- Set ws1 = Worksheets(フォルダ作成)
67
+ Set ws1 = Worksheets("フォルダ作成")
68
68
 
69
- cmax = ws1.Range(A65536).End(xlUp).Row
69
+ cmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row
70
70
 
71
- cnt = ws1.Range(IV4).End(xlToLeft).Column
71
+ cnt = ws1.Cells(4, Columns.Count).End(xlToLeft).Column
72
72
 
73
-
73
+
74
74
 
75
75
  '[1] セルB2にURLが記載されているかチェック
76
76
 
77
- If ws1.Range(B2).Value = Then
77
+ If ws1.Range("B2").Value = "" Then
78
78
 
79
- MsgBox セルB2に「作成先のフォルダURL」を入力して下さい
79
+ MsgBox "セルB2に「作成先のフォルダURL」を入力して下さい"
80
80
 
81
- ws1.Range(B2).Activate
81
+ ws1.Range("B2").Activate
82
82
 
83
83
  Exit Sub
84
84
 
85
85
  End If
86
86
 
87
-
88
87
 
89
- url = ws1.Range(B2).Value
90
88
 
91
-
89
+ url = ws1.Range("B2").Value
90
+
91
+
92
92
 
93
93
  '[2] 同じ行に複数回記入されていないことを確認
94
94
 
@@ -98,7 +98,7 @@
98
98
 
99
99
  For j = 0 To cnt - 2
100
100
 
101
- If ws1.Range(B ; i).Offset(0, j).Value <> Then
101
+ If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
102
102
 
103
103
  x = x + 1
104
104
 
@@ -106,9 +106,9 @@
106
106
 
107
107
  Next
108
108
 
109
-
110
109
 
110
+
111
- If x &gt; 1 Then
111
+ If x > 1 Then
112
112
 
113
113
  z = z + 1
114
114
 
@@ -116,19 +116,19 @@
116
116
 
117
117
  Next
118
118
 
119
-
119
+
120
120
 
121
121
  '[3] 同じ行に複数回記入されていた場合、処理を止める
122
122
 
123
- If z &gt; 0 Then
123
+ If z > 0 Then
124
124
 
125
- MsgBox 入力情報を見直してください
125
+ MsgBox "入力情報を見直してください"
126
126
 
127
127
  Exit Sub
128
128
 
129
129
  End If
130
130
 
131
-
131
+
132
132
 
133
133
  '[4] 階層別にフォルダを作成する
134
134
 
@@ -136,11 +136,11 @@
136
136
 
137
137
  For i = 5 To cmax
138
138
 
139
- If ws1.Range(B ; i).Offset(0, j).Value &lt;&gt; Then
139
+ If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
140
140
 
141
- s1 = ws1.Range(B ; i).Offset(0, j).Value
141
+ s1 = ws1.Cells(i, 2).Offset(0, j).Value
142
142
 
143
-
143
+
144
144
 
145
145
  For k = 0 To j
146
146
 
@@ -150,15 +150,15 @@
150
150
 
151
151
  End If
152
152
 
153
- n1 = ws1.Range(B ; i).Offset(0, j - k - 1).End(xlUp).Row
153
+ n1 = ws1.Cells(i, 2).Offset(0, j - k - 1).End(xlUp).Row
154
154
 
155
- s1 = ws1.Range(B ; n1).Offset(0, j - k - 1).Value ; \ ; s1
155
+ s1 = ws1.Cells(n1, 2).Offset(0, j - k - 1).Value & "\" & s1
156
156
 
157
157
  Next
158
158
 
159
-
160
159
 
160
+
161
- s = url ; \ ; s1
161
+ s = url & "\" & s1
162
162
 
163
163
  fs.CreateFolder s
164
164
 
@@ -168,10 +168,10 @@
168
168
 
169
169
  Next
170
170
 
171
-
171
+
172
172
 
173
173
  Set fs = Nothing
174
174
 
175
- End Sub
175
+ End Sub 
176
176
 
177
177
  ```