teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問VBA　他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい

編集履歴

回答編集履歴

8

個人的な情報が入ったままでしたので、削除しただけです。コードに変更はありません。

2020/08/22 08:32

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -56,7 +56,7 @@
56
56
 
57
57
 
58
58
 
59
- strPath = "C:\Users\kitasue\Documents\工数表は５シート目.xlsm"
59
+ strPath = "工数表は５シート目.xlsm"
60
60
 
61
61
  Set wbkKousu = Workbooks.Open(strPath)
62
62
 

7

スペルミスの修正

2020/08/22 08:32

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -98,7 +98,7 @@
98
98
 
99
99
  '2020/08/21 15:25 add start
100
100
 
101
- wshKousu.Range(wshKousu.Cells(cnsRowKousuBgn, cnsColKousuBgn), wshKousu.Cells(lngRowKousuEnd, lngColKousuEnd)).ClearComments
101
+ wshKousu.Range(wshKousu.Cells(cnsRowKousuBgn, cnsColKousuBgn), wshKousu.Cells(lngRowKousuEnd, lngColKousuEnd)).ClearContents
102
102
 
103
103
  '2020/08/21 15:25 add end
104
104
 

6

空白項目のチェックを追加

2020/08/21 07:41

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -56,7 +56,7 @@
56
56
 
57
57
 
58
58
 
59
- strPath = "工数表は５シート目.xlsm"
59
+ strPath = "C:\Users\kitasue\Documents\工数表は５シート目.xlsm"
60
60
 
61
61
  Set wbkKousu = Workbooks.Open(strPath)
62
62
 
@@ -74,7 +74,11 @@
74
74
 
75
75
  ' dctRowKomoku.Add wshKousu.Cells(lngRow, cnsColKousuKomoku).Value, lngRow
76
76
 
77
+ If Trim(wshKousu.Cells(lngRow, cnsColKousuKomoku).Value) <> "" Then
78
+
77
- dctRowKomoku.Add Trim(wshKousu.Cells(lngRow, cnsColKousuKomoku).Value), lngRow
79
+ dctRowKomoku.Add Trim(wshKousu.Cells(lngRow, cnsColKousuKomoku).Value), lngRow
80
+
81
+ End If
78
82
 
79
83
  '2020/08/21 14:29 upd end
80
84
 

5

私の個人的な情報を削除

2020/08/21 07:01

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -56,7 +56,7 @@
56
56
 
57
57
 
58
58
 
59
- strPath = "C:\Users\kitasue\Documents\工数表は５シート目.xlsm"
59
+ strPath = "工数表は５シート目.xlsm"
60
60
 
61
61
  Set wbkKousu = Workbooks.Open(strPath)
62
62
 

4

集計値を初期クリアする処理を追加

2020/08/21 06:28

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -56,7 +56,7 @@
56
56
 
57
57
 
58
58
 
59
- strPath = "工数表は５シート目.xlsm"
59
+ strPath = "C:\Users\kitasue\Documents\工数表は５シート目.xlsm"
60
60
 
61
61
  Set wbkKousu = Workbooks.Open(strPath)
62
62
 
@@ -92,11 +92,11 @@
92
92
 
93
93
  Next lngCol
94
94
 
95
-
95
+ '2020/08/21 15:25 add start
96
96
 
97
97
  wshKousu.Range(wshKousu.Cells(cnsRowKousuBgn, cnsColKousuBgn), wshKousu.Cells(lngRowKousuEnd, lngColKousuEnd)).ClearComments
98
98
 
99
-
99
+ '2020/08/21 15:25 add end
100
100
 
101
101
  For lngWshNum = 1 To ThisWorkbook.Worksheets.Count
102
102
 

3

Const値を変更

2020/08/21 06:27

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -6,7 +6,7 @@
6
6
 
7
7
  Const cnsRowKousuHizuke = 3
8
8
 
9
- Const cnsRowKousuBgn = 3
9
+ Const cnsRowKousuBgn = 4
10
10
 
11
11
  Const cnsColKousuKomoku = 4
12
12
 
@@ -16,7 +16,7 @@
16
16
 
17
17
  Const cnsRowYoteiBgn = 3
18
18
 
19
- Const cnsColYoteiBgn = 10
19
+ Const cnsColYoteiBgn = 6
20
20
 
21
21
 
22
22
 

2

日付行を３行目に変更

2020/08/21 06:24

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -4,7 +4,7 @@
4
4
 
5
5
  Sub KosuBook()
6
6
 
7
- Const cnsRowKousuHizuke = 2
7
+ Const cnsRowKousuHizuke = 3
8
8
 
9
9
  Const cnsRowKousuBgn = 3
10
10
 

1

項目名から空白を削除してみた

2020/08/21 05:43

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -70,7 +70,13 @@
70
70
 
71
71
  Do Until lngRow > lngRowKousuEnd
72
72
 
73
+ '2020/08/21 14:29 upd start
74
+
75
+ ' dctRowKomoku.Add wshKousu.Cells(lngRow, cnsColKousuKomoku).Value, lngRow
76
+
73
- dctRowKomoku.Add wshKousu.Cells(lngRow, cnsColKousuKomoku).Value, lngRow
77
+ dctRowKomoku.Add Trim(wshKousu.Cells(lngRow, cnsColKousuKomoku).Value), lngRow
78
+
79
+ '2020/08/21 14:29 upd end
74
80
 
75
81
  lngRow = wshKousu.Cells(lngRow, cnsColKousuKomoku).End(xlDown).Row
76
82
 
@@ -88,6 +94,10 @@
88
94
 
89
95
 
90
96
 
97
+ wshKousu.Range(wshKousu.Cells(cnsRowKousuBgn, cnsColKousuBgn), wshKousu.Cells(lngRowKousuEnd, lngColKousuEnd)).ClearComments
98
+
99
+
100
+
91
101
  For lngWshNum = 1 To ThisWorkbook.Worksheets.Count
92
102
 
93
103
  With ThisWorkbook.Worksheets(lngWshNum)
@@ -100,7 +110,13 @@
100
110
 
101
111
  For lngRow = cnsRowYoteiBgn To lngRowYoteiEnd
102
112
 
113
+ '2020/08/21 14:29 upd start
114
+
115
+ ' lngRowKousu = dctRowKomoku.Item(.Cells(lngRow, lngCol).Value)
116
+
103
- lngRowKousu = dctRowKomoku.Item(.Cells(lngRow, lngCol).Value)
117
+ lngRowKousu = dctRowKomoku.Item(Trim(.Cells(lngRow, lngCol).Value))
118
+
119
+ '2020/08/21 14:29 upd end
104
120
 
105
121
  lngColKousu = dctColHizuke.Item(.Cells(cnsRowYoteiHizuke, lngCol - 1).Value)
106
122