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

質問編集履歴

8

変更

2020/08/05 01:26

投稿

beginner101
beginner101

スコア18

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
  ![イメージ説明](9538d9f8874d86a802302468542881da.png)
24
24
 

7

変更

2020/08/05 01:26

投稿

beginner101
beginner101

スコア18

title CHANGED
@@ -1,1 +1,1 @@
1
- 他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい
1
+ VBA 他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい
body CHANGED
File without changes

6

変更

2020/08/04 09:20

投稿

beginner101
beginner101

スコア18

title CHANGED
File without changes
body CHANGED
@@ -36,7 +36,7 @@
36
36
  ### 該当のソースコード
37
37
 
38
38
  ```ここに言語名を入力
39
- Sub ReferOtherBook()
39
+ Sub KosuBook()
40
40
  Dim ex As Excel.Application '処理用Excel
41
41
  Dim wb As Workbook
42
42
  Dim sPath 'ブックファイルパス

5

変更

2020/08/04 08:39

投稿

beginner101
beginner101

スコア18

title CHANGED
File without changes
body CHANGED
@@ -29,7 +29,8 @@
29
29
 
30
30
  ![イメージ説明](9b4dc3a7bfe531aee0dd5e2fc25a3767.png)
31
31
 
32
- 工数がM4セルから入力される
32
+ 工数がM4セルから入力される
33
+ 集計し終わったら、下の項目に移動して、項目がなくなるまで続ける
33
34
 
34
35
 
35
36
  ### 該当のソースコード

4

変更点

2020/08/04 04:12

投稿

beginner101
beginner101

スコア18

title CHANGED
File without changes
body CHANGED
@@ -18,13 +18,18 @@
18
18
  転記元のシート名は毎回異なる
19
19
  転記元の日付は日付が入っているセルの左に書いてある
20
20
 
21
+ 予定表 一週間ごとに別のシート ここの作業名の数を合計して0.5掛ける
22
+
23
+ ![イメージ説明](9538d9f8874d86a802302468542881da.png)
24
+
21
25
  工数表 項目は複数存在
22
- ![イメージ説明](9b4dc3a7bfe531aee0dd5e2fc25a3767.png)
26
+ ![イメージ説明](6617c70959fe851eae81d170ef42f1e4.png)
23
27
 
24
- 予定表 一週間ごとに別のシート
28
+ ↓マクロ起動後
25
29
 
26
- ![イメージ説明](9538d9f8874d86a802302468542881da.png)
30
+ ![イメージ説明](9b4dc3a7bfe531aee0dd5e2fc25a3767.png)
27
31
 
32
+ 工数がM4セルから入力される
28
33
 
29
34
 
30
35
  ### 該当のソースコード

3

変更

2020/08/04 04:10

投稿

beginner101
beginner101

スコア18

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
- ![イメージ説明](6a74a9dfb1d22ec31b5ca94cd847b1b8.png)
22
+ ![イメージ説明](9b4dc3a7bfe531aee0dd5e2fc25a3767.png)
10
23
 
11
24
  予定表 一週間ごとに別のシート
12
25
 
13
- ![イメージ説明](3ccc30f967378f3bce4e99c7cb1858d3.png)
26
+ ![イメージ説明](9538d9f8874d86a802302468542881da.png)
14
27
 
15
28
 
16
29
 

2

変更点2

2020/08/04 00:13

投稿

beginner101
beginner101

スコア18

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 '// 処理用Excel
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 = "https://jssnet-my.sharepoint.com/personal/takeshita_naoyuki_jss-net_com/Documents/takeshita/D/20200718_%E9%80%B2%E6%8D%97%E7%AE%A1%E7%90%86%E3%82%B7%E3%83%BC%E3%83%88/2020_07(%E7%AB%B9%E4%B8%8B).xlsm"
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
- '// 新規Excelで読み取り専用で開く
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 tbook.Sheets.Count
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

変更点

2020/08/03 07:45

投稿

beginner101
beginner101

スコア18

title CHANGED
File without changes
body CHANGED
@@ -10,8 +10,10 @@
10
10
 
11
11
  予定表 一週間ごとに別のシート
12
12
 
13
+ ![イメージ説明](3ccc30f967378f3bce4e99c7cb1858d3.png)
13
14
 
14
15
 
16
+
15
17
  ### 該当のソースコード
16
18
 
17
19
  ```ここに言語名を入力