teratail
回答率
85.30%
質問するログイン新規登録
トップに関する質問共有サーバ上のブックからデータを転記する

編集履歴

質問編集履歴

8

不要箇所削除

2020/10/05 08:19

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -67,8 +67,6 @@
67
67
  ```
68
68
  Sub 呼び出し()
69
69
  Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
70
- Dim fieldList()
71
- Dim rangeList()
72
70
  Dim wb As Workbook, ws As Worksheet
73
71
  Dim myPath As String, fn As String
74
72
  Dim j As Long

7

誤字修正

2020/10/05 08:19

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -54,12 +54,12 @@
54
54
  '見出し行を除いた可視セル範囲を選択
55
55
  Set myRange = Application.Intersect(dataTable.SpecialCells(xlCellTypeVisible), dataTable.Rows("2:" & dataTable.Rows.Count))
56
56
 
57
- ThisWorkbook.Worksheets("見積入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
57
+ ThisWorkbook.Worksheets("入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
58
- ThisWorkbook.Worksheets("見積入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
58
+ ThisWorkbook.Worksheets("入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
59
- ThisWorkbook.Worksheets("見積入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
59
+ ThisWorkbook.Worksheets("入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
60
- ThisWorkbook.Worksheets("見積入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
60
+ ThisWorkbook.Worksheets("入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
61
- ThisWorkbook.Worksheets("見積入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
61
+ ThisWorkbook.Worksheets("入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
62
- ThisWorkbook.Worksheets("見積入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
62
+ ThisWorkbook.Worksheets("入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
63
63
  ```
64
64
 
65
65
  ### 該当のソースコード
@@ -105,7 +105,7 @@
105
105
  '検索元テーブルセット（データシートの名前の定義"データシート"）
106
106
  Set dataTable = wb.ws.Range("データシート")
107
107
 
108
- '検索値でオートフィルタ
108
+ '検索値でオートフィルタ（ブック２データシート）
109
109
  dataTable.AutoFilter 1, tmpint
110
110
 
111
111
  '検索値がなければメッセージを表示して処理を抜ける
@@ -121,12 +121,12 @@
121
121
  '見出し行を除いた可視セル範囲を取得
122
122
  Set myRange = Application.Intersect(dataTable.SpecialCells(xlCellTypeVisible), dataTable.Rows("2:" & dataTable.Rows.Count))
123
123
 
124
- ThisWorkbook.Worksheets("見積入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
124
+ ThisWorkbook.Worksheets("入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
125
- ThisWorkbook.Worksheets("見積入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
125
+ ThisWorkbook.Worksheets("入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
126
- ThisWorkbook.Worksheets("見積入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
126
+ ThisWorkbook.Worksheets("入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
127
- ThisWorkbook.Worksheets("見積入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
127
+ ThisWorkbook.Worksheets("入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
128
- ThisWorkbook.Worksheets("見積入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
128
+ ThisWorkbook.Worksheets("入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
129
- ThisWorkbook.Worksheets("見積入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
129
+ ThisWorkbook.Worksheets("入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
130
130
 
131
131
  'フィルターをかけた後、ブック２の見出し除くセルN3からAG最下行を選択
132
132
  With ws
@@ -136,7 +136,7 @@
136
136
  End With
137
137
  End With
138
138
  'ブック１のセルB16に貼りつけ
139
- ThisWorkbook.Worksheets("見積入力フォーム").Range("B16").PasteSpecial (xlPasteValues)
139
+ ThisWorkbook.Worksheets("入力フォーム").Range("B16").PasteSpecial (xlPasteValues)
140
140
 
141
141
  dataTable.AutoFilter 'フィルタ解除
142
142
  wb.Close False

6

情報修正

2020/10/05 08:15

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -45,24 +45,33 @@
45
45
 
46
46
  ### 発生している問題
47
47
 
48
- rangeListやThisWorkbook.Worksheet.Arrayの箇所でエラーが発生します。
48
+ ブック２からブック１へ転記する際、フィルターをかけ見出し以外を選択したいですが、見出し部分が転記されてしまいます。
49
- ブック１を指定できず適切なコードが分からないです。
50
- ここ以下のコードは進めないため未検証な状態です。申し訳ございません。
51
49
 
52
- 他に、このコードを実行するたびに、タスクマネージャーのバックグラウンドプロセスのエクセルが増えてしまいます。エクセルを閉じても増えた分はバックグラウンドプロセスに残ったままです。
50
+ エラーが発生せずどこが原因か分からないでいます。
53
- ※５回このコードを実行するとバックグラウンドプロセスに6個（元1個+実行5個）でき、エクセルを閉じても５個残ったまま（元1個は消える）。
51
+ おそらく以下コードが原因だと推測してるのですが、躓いています。
54
52
 
53
+ ```
54
+ '見出し行を除いた可視セル範囲を選択
55
- これはExcelApp.QuitやWb.Closeで回避できるのでしょうか。もしくは現在作り途中のエラーが出る中途半端なコードであり、適切なコードであれば解消されるのでしょうか。
55
+ Set myRange = Application.Intersect(dataTable.SpecialCells(xlCellTypeVisible), dataTable.Rows("2:" & dataTable.Rows.Count))
56
56
 
57
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
58
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
59
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
60
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
61
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
62
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
63
+ ```
64
+
57
65
  ### 該当のソースコード
58
-
66
+ 全コード
59
67
  ```
60
68
  Sub 呼び出し()
61
- Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
69
+ Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
62
70
  Dim fieldList()
63
71
  Dim rangeList()
64
72
  Dim wb As Workbook, ws As Worksheet
65
73
  Dim myPath As String, fn As String
74
+ Dim j As Long
66
75
 
67
76
  myPath = "\共有サーバ\"
68
77
  fn = "データシート.xlsm"
@@ -88,14 +97,14 @@
88
97
  wb.Activate
89
98
  ws.Activate
90
99
  End If
100
+
91
-
101
+ Application.ScreenUpdating = False
102
+
103
+ '検索値のセット（ブック１入力フォーム）
92
- tmpint = ThisWorkbook.Worksheets("入力フォーム").Range("J1").Text '検索値のセット
104
+ tmpint = ThisWorkbook.Worksheets("入力フォーム").Range("J1").Text
105
+ '検索元テーブルセット（データシートの名前の定義"データシート"）
93
- Set dataTable = wb.ws.Range("データシート") '検索元テーブルセット
106
+ Set dataTable = wb.ws.Range("データシート")
94
- '転記したいフィールドを指定（ブック２）
107
+
95
- fieldList = Array(14, 15, 16, 17, 18, 20, 21, 22, 23, 24, 26, 27, 28, 29, 30, 31, 32, 33)
96
- '転記先のセル位置を指定（ブック１）
97
- rangeList = ThisWorkbook.Worksheet.Array("B16", "C16", "D16", "E16", "F16", "H16", "I16", "J16", "K16", "L16", "N16", "O16", "P16", "Q16", "R16", "S16", "T16", "U16")
98
-
99
108
  '検索値でオートフィルタ
100
109
  dataTable.AutoFilter 1, tmpint
101
110
 
@@ -112,20 +121,26 @@
112
121
  '見出し行を除いた可視セル範囲を取得
113
122
  Set myRange = Application.Intersect(dataTable.SpecialCells(xlCellTypeVisible), dataTable.Rows("2:" & dataTable.Rows.Count))
114
123
 
115
- Range("B2").Value = myRange.Cells(2).Value '日時を転記
116
- Range("A4").Value = myRange.Cells(7).Value 'コードを転記
124
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("A4").Value = myRange.Cells(7).Value 'ブック2フィルターされた7列目をブック1A4に転記
117
- Range("C9").Value = myRange.Cells(35).Value '場所を転記
125
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("C9").Value = myRange.Cells(36).Value 'ブック2フィルターされた36列目をブック1C9に転記
118
- Range("C11").Value = myRange.Cells(34).Value 'メモを転記
126
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("C11").Value = myRange.Cells(35).Value 'ブック2フィルターされた35列目をブック1C11に転記
119
- Range("K12").Value = myRange.Cells(33).Value 'ユーザを転記
127
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("K12").Value = myRange.Cells(34).Value 'ブック2フィルターされた34列目をブック1K12に転記
120
- Range("K13").Value = myRange.Cells(37).Value 'フラグを転記
128
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("K13").Value = myRange.Cells(38).Value 'ブック2フィルターされた38列目をブック1K13に転記
121
- Range("F13").Value = myRange.Cells(38).Value '手数料を転記
129
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("F13").Value = myRange.Cells(39).Value 'ブック2フィルターされた39列目をブック1F13に転記
122
130
 
131
+ 'フィルターをかけた後、ブック２の見出し除くセルN3からAG最下行を選択
132
+ With ws
133
+ With ws.Range("A1").CurrentRegion
134
+ j = .Rows.Count
135
+ .Range(.Cells(3, 14), .Cells(j, 33)).Copy
136
+ End With
137
+ End With
123
- '指定したフィールドを指定したセル位置に転記
138
+ 'ブック１のセルB16に貼りつけ
124
- For i = 0 To UBound(fieldList)
125
- myRange.Columns(fieldList(i)).Copy Range(rangeList(i))
139
+ ThisWorkbook.Worksheets("見積入力フォーム").Range("B16").PasteSpecial (xlPasteValues)
126
-
127
- Next
140
+
128
141
  dataTable.AutoFilter 'フィルタ解除
142
+ wb.Close False
143
+ Application.ScreenUpdating = True
129
144
 
130
145
  End Sub
131
146
  ```

5

間違い箇所修正

2020/10/05 08:07

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -56,7 +56,8 @@
56
56
 
57
57
  ### 該当のソースコード
58
58
 
59
+ ```
59
- ```Sub 呼び出し()
60
+ Sub 呼び出し()
60
61
  Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
61
62
  Dim fieldList()
62
63
  Dim rangeList()
@@ -127,7 +128,6 @@
127
128
  dataTable.AutoFilter 'フィルタ解除
128
129
 
129
130
  End Sub
130
- コード
131
131
  ```
132
132
 
133
133
  ### 試したこと
@@ -136,7 +136,8 @@
136
136
  ですがブックを２つに分けた際上記の問題がでてしまいます。
137
137
  ブック名：入力フォーム.xlsm、シート名：sheet1="入力フォーム"、sheet2="データシート"
138
138
 
139
+ ```
139
- ```Sub 呼び出し()
140
+ Sub 呼び出し()
140
141
  Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
141
142
  Dim fieldList(), rangeList()
142
143
  '検索値のセット

4

情報追記

2020/10/02 13:49

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -10,7 +10,7 @@
10
10
  ・ブック２＝ブック名：データシート.xlsm、シート名：データシート
11
11
  ・ブック１はコピーし複数人で利用します。（複数の入力フォームブックで作成したデータを、逐一データベース用のブックに蓄積していき、必要に応じて呼び出す）
12
12
  ・ブック１からブック２へデータを転記し蓄積するたび、ブック２は以下コードで定義を更新しています。
13
- wb.Names("データシート").RefersTo = ws.Range("データシート").CurrentRegion
13
+ ```wb.Names("データシート").RefersTo = ws.Range("データシート").CurrentRegion
14
14
  wb.Activate
15
15
  ws.Select
16
16
  ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0).Select
@@ -18,6 +18,8 @@
18
18
  wb.Save
19
19
  Application.DisplayAlerts = True
20
20
  wb.Close False
21
+ コード
22
+ ```
21
23
 
22
24
  利用手順
23
25
  A.ブック１、入力フォームのセルに転記された内容をコマンドボタン「転記」にて、ブック２、データ蓄積のデータベースブックに転記する。
@@ -88,8 +90,10 @@
88
90
 
89
91
  tmpint = ThisWorkbook.Worksheets("入力フォーム").Range("J1").Text '検索値のセット
90
92
  Set dataTable = wb.ws.Range("データシート") '検索元テーブルセット
93
+ '転記したいフィールドを指定（ブック２）
91
- fieldList = Array(14, 15, 16, 17, 18, 20, 21, 22, 23, 24, 26, 27, 28, 29, 30, 31, 32, 33) '転記したいフィールドを指定
94
+ fieldList = Array(14, 15, 16, 17, 18, 20, 21, 22, 23, 24, 26, 27, 28, 29, 30, 31, 32, 33)
95
+ '転記先のセル位置を指定（ブック１）
92
- rangeList = ThisWorkbook.Worksheet.Array("B16", "C16", "D16", "E16", "F16", "H16", "I16", "J16", "K16", "L16", "N16", "O16", "P16", "Q16", "R16", "S16", "T16", "U16") '転記先のセル位置を指定
96
+ rangeList = ThisWorkbook.Worksheet.Array("B16", "C16", "D16", "E16", "F16", "H16", "I16", "J16", "K16", "L16", "N16", "O16", "P16", "Q16", "R16", "S16", "T16", "U16")
93
97
 
94
98
  '検索値でオートフィルタ
95
99
  dataTable.AutoFilter 1, tmpint
@@ -128,5 +132,53 @@
128
132
 
129
133
  ### 試したこと
130
134
 
131
- ブックを１つで２シート（入力フォームシート、データシートシート）での作成では呼び出し（転記）ができました。
135
+ 以下コードのように、ブックを１つで２シート（入力フォームシート、データシートシート）での作成では呼び出し（転記）ができました。
132
- ですがブックを２つに分けた際上記の問題がでてしまいます。
136
+ ですがブックを２つに分けた際上記の問題がでてしまいます。
137
+ ブック名：入力フォーム.xlsm、シート名：sheet1="入力フォーム"、sheet2="データシート"
138
+
139
+ ```Sub 呼び出し()
140
+ Dim tmpint As Variant, dataTable As Range, myRange As Range, i As Long
141
+ Dim fieldList(), rangeList()
142
+ '検索値のセット
143
+ tmpint = Sheets("入力フォーム").Range("J1").Text
144
+ '検索元テーブルセット（range"データシート"は名前の定義）
145
+ Set dataTable = Sheets("データシート").Range("データシート")
146
+ '転記したいフィールド（データシートsheet）を指定
147
+ fieldList = Array(9, 10, 11, 12)
148
+ '転記先（入力フォームsheet）のセル位置を指定
149
+ rangeList = Array("B12", "C12", "D12", "E12")
150
+
151
+ '検索値でオートフィルタ
152
+ dataTable.AutoFilter 1, tmpint
153
+
154
+ '検索値がなければメッセージを表示して処理を抜ける
155
+ Set myRange = dataTable.SpecialCells(xlCellTypeVisible)
156
+ If myRange.Cells.Count = myRange.Columns.Count Then
157
+
158
+ MsgBox "該当するレコードはありませんでした"
159
+
160
+ dataTable.AutoFilter
161
+ Exit Sub
162
+ End If
163
+
164
+ '見出し行を除いた可視セル範囲を取得
165
+ Set myRange = Application.Intersect(dataTable.SpecialCells(xlCellTypeVisible), dataTable.Rows("2:" & dataTable.Rows.Count))
166
+
167
+ Range("I9").Value = myRange.Cells(2).Value 'ﾃﾞｰﾀｼｰﾄ２列目を入力ﾌｫｰﾑI9に転記
168
+ Range("I6").Value = myRange.Cells(3).Value 'ﾃﾞｰﾀｼｰﾄ３列目を入力ﾌｫｰﾑI6に転記
169
+ Range("I7").Value = myRange.Cells(4).Value 'ﾃﾞｰﾀｼｰﾄ４列目を入力ﾌｫｰﾑI7に転記
170
+ Range("I1").Value = myRange.Cells(5).Value 'ﾃﾞｰﾀｼｰﾄ５列目を入力ﾌｫｰﾑI1に転記
171
+ Range("C4").Value = myRange.Cells(6).Value 'ﾃﾞｰﾀｼｰﾄ６列目を入力ﾌｫｰﾑC4に転記
172
+ Range("C5").Value = myRange.Cells(7).Value 'ﾃﾞｰﾀｼｰﾄ７列目を入力ﾌｫｰﾑC5に転記
173
+ Range("C6").Value = myRange.Cells(8).Value 'ﾃﾞｰﾀｼｰﾄ８列目を入力ﾌｫｰﾑC6に転記
174
+
175
+ '指定したﾌｨｰﾙﾄﾞ（ﾃﾞｰﾀｼｰﾄsheet）を指定したｾﾙ位置（入力ﾌｫｰﾑsheet）に転記
176
+ For i = 0 To UBound(fieldList)
177
+ myRange.Columns(fieldList(i)).Copy Range(rangeList(i))
178
+
179
+ Next
180
+ dataTable.AutoFilter 'フィルタ解除
181
+
182
+ End Sub
183
+ コード
184
+ ```

3

情報追記

2020/10/02 09:15

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -6,9 +6,18 @@
6
6
  ### 前提・実現したいこと
7
7
 
8
8
  仕様として、２つブックを用意し、１つは入力フォーム、２つ目はデータ蓄積のデータベースブック。
9
- ブック１＝ブック名：入力フォーム.xlsm、シート名：入力フォーム
9
+ ・ブック１＝ブック名：入力フォーム.xlsm、シート名：入力フォーム
10
- ブック２＝ブック名：データシート.xlsm、シート名：データシート
10
+ ・ブック２＝ブック名：データシート.xlsm、シート名：データシート
11
- ブック１はコピーし複数人で利用します。（複数の入力フォームブックで作成したデータを、逐一データベース用のブックに蓄積していき、必要に応じて呼び出す）
11
+ ・ブック１はコピーし複数人で利用します。（複数の入力フォームブックで作成したデータを、逐一データベース用のブックに蓄積していき、必要に応じて呼び出す）
12
+ ・ブック１からブック２へデータを転記し蓄積するたび、ブック２は以下コードで定義を更新しています。
13
+ wb.Names("データシート").RefersTo = ws.Range("データシート").CurrentRegion
14
+ wb.Activate
15
+ ws.Select
16
+ ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0).Select
17
+ Application.DisplayAlerts = False
18
+ wb.Save
19
+ Application.DisplayAlerts = True
20
+ wb.Close False
12
21
 
13
22
  利用手順
14
23
  A.ブック１、入力フォームのセルに転記された内容をコマンドボタン「転記」にて、ブック２、データ蓄積のデータベースブックに転記する。
@@ -25,6 +34,7 @@
25
34
  また、ブック２からブック１への呼び出しの際は「値のみ貼りつけ」で転記したいです。
26
35
 
27
36
  ↓【ブック２"データシート.xlsm"、シート名"データシート"】　蓄積されたデータシート
37
+ 　蓄積範囲A2～AM＊は増えた分名前の定義を更新しています。名前定義：データシート
28
38
  ![イメージ説明](5dd298ae34fdf3736cb9fc8effb40ae9.jpeg)
29
39
 
30
40
  ↓【ブック１"入力フォーム.xlsm"、シート名"入力フォーム"】　呼び出し後のイメージ

2

情報追記

2020/10/02 08:33

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -6,7 +6,9 @@
6
6
  ### 前提・実現したいこと
7
7
 
8
8
  仕様として、２つブックを用意し、１つは入力フォーム、２つ目はデータ蓄積のデータベースブック。
9
+ ブック１＝ブック名：入力フォーム.xlsm、シート名：入力フォーム
10
+ ブック２＝ブック名：データシート.xlsm、シート名：データシート
9
- 入力フォームブックはコピーし複数人で利用します。（複数の入力フォームブックで作成したデータを、逐一データベース用のブックに蓄積していき、必要に応じて呼び出す）
11
+ ブック１はコピーし複数人で利用します。（複数の入力フォームブックで作成したデータを、逐一データベース用のブックに蓄積していき、必要に応じて呼び出す）
10
12
 
11
13
  利用手順
12
14
  A.ブック１、入力フォームのセルに転記された内容をコマンドボタン「転記」にて、ブック２、データ蓄積のデータベースブックに転記する。
@@ -22,10 +24,10 @@
22
24
  例).ブック１のセル「J1」に通しNo.の「31」を入力し、ブック２のA列を参照し、該当データをブック１へ呼び出す（転記）
23
25
  また、ブック２からブック１への呼び出しの際は「値のみ貼りつけ」で転記したいです。
24
26
 
25
- ↓【ブック２】　蓄積されたデータシート
27
+ ↓【ブック２"データシート.xlsm"、シート名"データシート"】　蓄積されたデータシート
26
28
  ![イメージ説明](5dd298ae34fdf3736cb9fc8effb40ae9.jpeg)
27
29
 
28
- ↓【ブック１】　呼び出し後のイメージ
30
+ ↓【ブック１"入力フォーム.xlsm"、シート名"入力フォーム"】　呼び出し後のイメージ
29
31
  ![イメージ説明](e0589875eeae3b31794ff0a3ab4d9a1d.jpeg)
30
32
 
31
33
 

1

不要箇所削除

2020/10/02 07:50

投稿

stinky
stinky

スコア2

title CHANGED
File without changes
body CHANGED
@@ -76,8 +76,8 @@
76
76
 
77
77
  tmpint = ThisWorkbook.Worksheets("入力フォーム").Range("J1").Text '検索値のセット
78
78
  Set dataTable = wb.ws.Range("データシート") '検索元テーブルセット
79
- fieldList = Array(14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33) '転記したいフィールドを指定
79
+ fieldList = Array(14, 15, 16, 17, 18, 20, 21, 22, 23, 24, 26, 27, 28, 29, 30, 31, 32, 33) '転記したいフィールドを指定
80
- rangeList = ThisWorkbook.Worksheet.Array("B16", "C16", "D16", "E16", "F16", "G16", "H16", "I16", "J16", "K16", "L16", "M16", "N16", "O16", "P16", "Q16", "R16", "S16", "T16", "U16") '転記先のセル位置を指定
80
+ rangeList = ThisWorkbook.Worksheet.Array("B16", "C16", "D16", "E16", "F16", "H16", "I16", "J16", "K16", "L16", "N16", "O16", "P16", "Q16", "R16", "S16", "T16", "U16") '転記先のセル位置を指定
81
81
 
82
82
  '検索値でオートフィルタ
83
83
  dataTable.AutoFilter 1, tmpint