質問編集履歴
4
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -24,6 +24,9 @@
|
|
|
24
24
|
下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されずフォルダも生成されない状態で処理が終了してしまいます。
|
|
25
25
|
何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
|
|
26
26
|
|
|
27
|
+
3/9再追記
|
|
28
|
+
セルに数式が入力されている状態だとうまくマクロが処理してくれないみたいで、数式を消すことでフォルダが正常に作成されました。
|
|
29
|
+
|
|
27
30
|
###コード
|
|
28
31
|
```VBA
|
|
29
32
|
Option Explicit
|
3
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -21,7 +21,7 @@
|
|
|
21
21
|
こちらのエラーを解決できる方がいらっしゃれば、ご回答をよろしくお願いします。
|
|
22
22
|
|
|
23
23
|
###3/9追記
|
|
24
|
-
下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示され
|
|
24
|
+
下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されずフォルダも生成されない状態で処理が終了してしまいます。
|
|
25
25
|
何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
|
|
26
26
|
|
|
27
27
|
###コード
|
2
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -20,6 +20,10 @@
|
|
|
20
20
|
VBAに関する知識が乏しく、調べても分からなかったため今回質問させていただきました。
|
|
21
21
|
こちらのエラーを解決できる方がいらっしゃれば、ご回答をよろしくお願いします。
|
|
22
22
|
|
|
23
|
+
###3/9追記
|
|
24
|
+
下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されることなく処理が終了してしまいます。
|
|
25
|
+
何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。
|
|
26
|
+
|
|
23
27
|
###コード
|
|
24
28
|
```VBA
|
|
25
29
|
Option Explicit
|
1
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -31,59 +31,59 @@
|
|
|
31
31
|
Dim n1 As Long
|
|
32
32
|
Dim fs As FileSystemObject
|
|
33
33
|
Set fs = New Scripting.FileSystemObject
|
|
34
|
-
Set ws1 = Worksheets(フォルダ作成)
|
|
34
|
+
Set ws1 = Worksheets("フォルダ作成")
|
|
35
|
-
cmax = ws1.
|
|
35
|
+
cmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row
|
|
36
|
-
cnt = ws1.
|
|
36
|
+
cnt = ws1.Cells(4, Columns.Count).End(xlToLeft).Column
|
|
37
|
-
|
|
37
|
+
|
|
38
38
|
'[1] セルB2にURLが記載されているかチェック
|
|
39
|
-
If ws1.Range(B2).Value =
|
|
39
|
+
If ws1.Range("B2").Value = "" Then
|
|
40
|
-
MsgBox セルB2に「作成先のフォルダURL」を入力して下さい
|
|
40
|
+
MsgBox "セルB2に「作成先のフォルダURL」を入力して下さい"
|
|
41
|
-
ws1.Range(B2).Activate
|
|
41
|
+
ws1.Range("B2").Activate
|
|
42
42
|
Exit Sub
|
|
43
43
|
End If
|
|
44
|
-
|
|
44
|
+
|
|
45
|
-
url = ws1.Range(B2).Value
|
|
45
|
+
url = ws1.Range("B2").Value
|
|
46
|
-
|
|
46
|
+
|
|
47
47
|
'[2] 同じ行に複数回記入されていないことを確認
|
|
48
48
|
For i = 5 To cmax
|
|
49
49
|
x = 0
|
|
50
50
|
For j = 0 To cnt - 2
|
|
51
|
-
If ws1.
|
|
51
|
+
If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
|
|
52
52
|
x = x + 1
|
|
53
53
|
End If
|
|
54
54
|
Next
|
|
55
|
-
|
|
55
|
+
|
|
56
|
-
If x
|
|
56
|
+
If x > 1 Then
|
|
57
57
|
z = z + 1
|
|
58
58
|
End If
|
|
59
59
|
Next
|
|
60
|
-
|
|
60
|
+
|
|
61
61
|
'[3] 同じ行に複数回記入されていた場合、処理を止める
|
|
62
|
-
If z
|
|
62
|
+
If z > 0 Then
|
|
63
|
-
MsgBox 入力情報を見直してください
|
|
63
|
+
MsgBox "入力情報を見直してください"
|
|
64
64
|
Exit Sub
|
|
65
65
|
End If
|
|
66
|
-
|
|
66
|
+
|
|
67
67
|
'[4] 階層別にフォルダを作成する
|
|
68
68
|
For j = 0 To cnt - 2
|
|
69
69
|
For i = 5 To cmax
|
|
70
|
-
If ws1.
|
|
70
|
+
If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
|
|
71
|
-
s1 = ws1.
|
|
71
|
+
s1 = ws1.Cells(i, 2).Offset(0, j).Value
|
|
72
|
-
|
|
72
|
+
|
|
73
73
|
For k = 0 To j
|
|
74
74
|
If k - j = 0 Then
|
|
75
75
|
Exit For
|
|
76
76
|
End If
|
|
77
|
-
n1 = ws1.
|
|
77
|
+
n1 = ws1.Cells(i, 2).Offset(0, j - k - 1).End(xlUp).Row
|
|
78
|
-
s1 = ws1.
|
|
78
|
+
s1 = ws1.Cells(n1, 2).Offset(0, j - k - 1).Value & "\" & s1
|
|
79
79
|
Next
|
|
80
|
-
|
|
80
|
+
|
|
81
|
-
s = url
|
|
81
|
+
s = url & "\" & s1
|
|
82
82
|
fs.CreateFolder s
|
|
83
83
|
End If
|
|
84
84
|
Next
|
|
85
85
|
Next
|
|
86
|
-
|
|
86
|
+
|
|
87
87
|
Set fs = Nothing
|
|
88
|
-
End Sub
|
|
88
|
+
End Sub
|
|
89
89
|
```
|