質問編集履歴
8
変更
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -18,7 +18,7 @@
|
|
|
18
18
|
転記元のシート名は毎回異なる
|
|
19
19
|
転記元の日付は日付が入っているセルの左に書いてある
|
|
20
20
|
|
|
21
|
-
予定表 一週間ごとに別のシート ここの作業名の数を合計して0.5掛ける
|
|
21
|
+
予定表 一週間ごとに別のシート ここの作業名の数を合計して0.5掛ける その他は無視する
|
|
22
22
|
|
|
23
23
|
|
|
24
24
|
|
7
変更
title
CHANGED
|
@@ -1,1 +1,1 @@
|
|
|
1
|
-
他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい
|
|
1
|
+
VBA 他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい
|
body
CHANGED
|
File without changes
|
6
変更
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -36,7 +36,7 @@
|
|
|
36
36
|
### 該当のソースコード
|
|
37
37
|
|
|
38
38
|
```ここに言語名を入力
|
|
39
|
-
Sub
|
|
39
|
+
Sub KosuBook()
|
|
40
40
|
Dim ex As Excel.Application '処理用Excel
|
|
41
41
|
Dim wb As Workbook
|
|
42
42
|
Dim sPath 'ブックファイルパス
|
5
変更
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -29,7 +29,8 @@
|
|
|
29
29
|
|
|
30
30
|
|
|
31
31
|
|
|
32
|
-
工数がM4セルから入力される
|
|
32
|
+
工数がM4セルから入力される。
|
|
33
|
+
集計し終わったら、下の項目に移動して、項目がなくなるまで続ける
|
|
33
34
|
|
|
34
35
|
|
|
35
36
|
### 該当のソースコード
|
4
変更点
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -18,13 +18,18 @@
|
|
|
18
18
|
転記元のシート名は毎回異なる
|
|
19
19
|
転記元の日付は日付が入っているセルの左に書いてある
|
|
20
20
|
|
|
21
|
+
予定表 一週間ごとに別のシート ここの作業名の数を合計して0.5掛ける
|
|
22
|
+
|
|
23
|
+
|
|
24
|
+
|
|
21
25
|
工数表 項目は複数存在
|
|
22
|
-
|
|
23
27
|
|
|
24
|
-
|
|
28
|
+
↓マクロ起動後
|
|
25
29
|
|
|
26
|
-
|
|
27
31
|
|
|
32
|
+
工数がM4セルから入力される
|
|
28
33
|
|
|
29
34
|
|
|
30
35
|
### 該当のソースコード
|
3
変更
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -5,12 +5,25 @@
|
|
|
5
5
|
VBAの内容に何が足りていないのかが分からず、悩んでいます。
|
|
6
6
|
どこを改良すればうまく動きますでしょうか。
|
|
7
7
|
|
|
8
|
+
手順
|
|
9
|
+
転記元ファイルのシート1のEからRまでの範囲を一列ごとに指定
|
|
10
|
+
空なら翌日に移動
|
|
11
|
+
列の単語ごとに何個ずつあるか計算し、0.5を掛ける
|
|
12
|
+
出した値を列の日付と項目の名前が同じところにあるセルに入力
|
|
13
|
+
その列で単語がなくなるまで繰り返す
|
|
14
|
+
単語がなくなったら翌日の実績列に移動
|
|
15
|
+
日曜日まで終わったら隣のシートに移動
|
|
16
|
+
シートがなくなるまで繰り返す
|
|
17
|
+
|
|
18
|
+
転記元のシート名は毎回異なる
|
|
19
|
+
転記元の日付は日付が入っているセルの左に書いてある
|
|
20
|
+
|
|
8
21
|
工数表 項目は複数存在
|
|
9
|
-
|
|
10
23
|
|
|
11
24
|
予定表 一週間ごとに別のシート
|
|
12
25
|
|
|
13
|
-
|
|
14
27
|
|
|
15
28
|
|
|
16
29
|
|
2
変更点2
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -18,66 +18,85 @@
|
|
|
18
18
|
|
|
19
19
|
```ここに言語名を入力
|
|
20
20
|
Sub ReferOtherBook()
|
|
21
|
-
Dim ex As Excel.Application '
|
|
21
|
+
Dim ex As Excel.Application '処理用Excel
|
|
22
22
|
Dim wb As Workbook
|
|
23
|
-
Dim sPath '
|
|
23
|
+
Dim sPath 'ブックファイルパス
|
|
24
|
-
Dim sht As Worksheet '
|
|
24
|
+
Dim sht As Worksheet '参照シート
|
|
25
25
|
Dim bFlg As Boolean
|
|
26
|
+
Dim kRow As Long
|
|
27
|
+
Dim cnt As Long
|
|
28
|
+
Dim i, j, k, kosu As Long
|
|
26
29
|
|
|
30
|
+
|
|
27
31
|
'開くブックを指定
|
|
28
|
-
sPath = "
|
|
32
|
+
sPath = "〇〇〇.xlsm"
|
|
29
33
|
|
|
30
|
-
'
|
|
34
|
+
'既に開かれているか確認
|
|
31
35
|
bFlg = IsBookOpened(sPath)
|
|
32
36
|
|
|
33
|
-
'
|
|
37
|
+
'開かれている場合
|
|
34
38
|
If bFlg = True Then
|
|
35
39
|
Set ex = New Excel.Application
|
|
36
|
-
'
|
|
40
|
+
'新規Excelで読み取り専用で開く
|
|
37
41
|
Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
|
|
38
42
|
Else
|
|
39
|
-
'
|
|
43
|
+
'現ブックで読み取り専用で開く
|
|
40
44
|
Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
|
|
41
45
|
End If
|
|
42
46
|
|
|
43
|
-
'工数を集計後、同じ工数にあたる
|
|
47
|
+
'工数を集計後、同じ工数にあたる項目を探し、合計を入力する
|
|
48
|
+
'1yori
|
|
44
|
-
'シートの数だけ繰り返し
|
|
49
|
+
'1と後の数字名シートの数だけ繰り返し
|
|
45
|
-
'詳細スケジュールの項目の日付のセルに作業数合計値×0.5を入力
|
|
46
|
-
For i = 1 To
|
|
50
|
+
For i = 1 To Worksheets.Count
|
|
51
|
+
'列ごとに繰り返し
|
|
52
|
+
For j = 6 To 18 Step 2
|
|
53
|
+
'最後のセルまで取得
|
|
54
|
+
kRow = Cells(Rows.Count, j).End(xlUp).Row
|
|
55
|
+
'調べる作業名（重複は除く）
|
|
56
|
+
|
|
57
|
+
k = 0
|
|
58
|
+
Do
|
|
59
|
+
n = InStr(k + 1, kRow, '作業名)
|
|
60
|
+
If k = 0 Then
|
|
61
|
+
Exit Do
|
|
62
|
+
Else
|
|
63
|
+
cnt = cnt + 1
|
|
64
|
+
End If
|
|
65
|
+
Loop
|
|
66
|
+
kousu = cnt * 0.5
|
|
67
|
+
'工数表のブックへ内容をコピー
|
|
68
|
+
|
|
69
|
+
Next j
|
|
70
|
+
Next i
|
|
71
|
+
|
|
47
72
|
|
|
48
|
-
mRow = ws02.Cells(Rows.Count, "C").End(xlUp).Row
|
|
49
|
-
'条件に一致したシート名を対象に処理
|
|
50
|
-
If tbook.Sheets(i).Name Like "売上*" Then
|
|
51
|
-
'対象のシートのセルA10より値を取得し、変数cntに加算
|
|
52
|
-
cnt = cnt + tbook.Sheets(i).Range("A10").Value
|
|
53
|
-
End If
|
|
54
|
-
Next i
|
|
55
|
-
|
|
56
|
-
'
|
|
73
|
+
'ブックを閉じる
|
|
57
74
|
Call wb.Close
|
|
58
75
|
|
|
59
76
|
If bFlg = True Then
|
|
60
77
|
Call ex.Application.Quit
|
|
61
78
|
End If
|
|
62
79
|
|
|
80
|
+
|
|
63
81
|
End Sub
|
|
64
82
|
|
|
65
83
|
'ブックオープン判定関数
|
|
66
84
|
Function IsBookOpened(a_sFilePath) As Boolean
|
|
67
85
|
On Error Resume Next
|
|
68
86
|
|
|
69
|
-
'
|
|
87
|
+
'保存済みのブックか判定
|
|
70
88
|
Open a_sFilePath For Append As #1
|
|
71
89
|
Close #1
|
|
72
90
|
|
|
73
91
|
If Err.Number > 0 Then
|
|
74
|
-
'
|
|
92
|
+
'既に開かれている場合
|
|
75
93
|
IsBookOpened = True
|
|
76
94
|
Else
|
|
77
|
-
'
|
|
95
|
+
'開かれていない場合
|
|
78
96
|
IsBookOpened = False
|
|
79
97
|
End If
|
|
80
98
|
End Function
|
|
99
|
+
|
|
81
100
|
```
|
|
82
101
|
|
|
83
102
|
### 補足情報（FW/ツールのバージョンなど）
|
1
変更点
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -10,8 +10,10 @@
|
|
|
10
10
|
|
|
11
11
|
予定表 一週間ごとに別のシート
|
|
12
12
|
|
|
13
|
+
|
|
13
14
|
|
|
14
15
|
|
|
16
|
+
|
|
15
17
|
### 該当のソースコード
|
|
16
18
|
|
|
17
19
|
```ここに言語名を入力
|