質問編集履歴
4
追記2
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -125,6 +125,7 @@
|
|
|
125
125
|
何卒宜しくお願い致します。
|
|
126
126
|
|
|
127
127
|
---
|
|
128
|
+
追記1
|
|
128
129
|
tatsu99様
|
|
129
130
|
以下ご確認のほどお願い致します。
|
|
130
131
|
|
|
@@ -235,4 +236,18 @@
|
|
|
235
236
|
'条件に合致した行のデータのみを対象して分析
|
|
236
237
|
ws2.Range("A" & n & ":M" & n).Value = ws1.Range("A" & i & ":M" & i).Value
|
|
237
238
|
n = n + 1
|
|
238
|
-
```
|
|
239
|
+
```
|
|
240
|
+
---
|
|
241
|
+
追記2
|
|
242
|
+
tatsu99様
|
|
243
|
+
再度ご確認のほど、宜しくお願い申し上げます。
|
|
244
|
+
|
|
245
|
+
＜検索用の画面の検索項目指定箇所＞
|
|
246
|
+
着色部分が検索項目として使用するものになります。
|
|
247
|
+
|
|
248
|
+
|
|
249
|
+
＜検索結果の表示部分＞
|
|
250
|
+
同様の項目をタイトルとして、検索ワードに該当した1行が転記されるようにしています。
|
|
251
|
+
|
|
252
|
+
|
|
253
|
+
上記2枚の画像でよろしいでしょうか…？
|
3
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -123,3 +123,116 @@
|
|
|
123
123
|
|
|
124
124
|
分かりにくい上に丸投げになっているように捉えられかねない内容となってしまっているかもしれませんが、皆様のお力をお借りしたく思います。
|
|
125
125
|
何卒宜しくお願い致します。
|
|
126
|
+
|
|
127
|
+
---
|
|
128
|
+
tatsu99様
|
|
129
|
+
以下ご確認のほどお願い致します。
|
|
130
|
+
|
|
131
|
+
＜マスターデータ＞
|
|
132
|
+
|
|
133
|
+
|
|
134
|
+
```ここに言語を入力
|
|
135
|
+
'プログラム0｜変数宣言の指定
|
|
136
|
+
Option Explicit
|
|
137
|
+
|
|
138
|
+
'プログラム開始
|
|
139
|
+
Sub ExtractData()
|
|
140
|
+
|
|
141
|
+
'シート設定
|
|
142
|
+
Dim ws1 As Worksheet, ws2 As Worksheet
|
|
143
|
+
Set ws1 = ThisWorkbook.Worksheets("概要一覧")
|
|
144
|
+
Set ws2 = ThisWorkbook.Worksheets("検索と抽出")
|
|
145
|
+
|
|
146
|
+
'各シートの最終行を取得
|
|
147
|
+
Dim cmax1 As Long, cmax2 As Long
|
|
148
|
+
cmax1 = ws1.Range("A1048576").End(xlUp).Row
|
|
149
|
+
cmax2 = ws2.Range("A1048576").End(xlUp).Row
|
|
150
|
+
|
|
151
|
+
'購入先を取得
|
|
152
|
+
Dim torihiki As String
|
|
153
|
+
torihiki = ws2.Range("C2").Value
|
|
154
|
+
|
|
155
|
+
'購入品の種類1を取得
|
|
156
|
+
Dim bihin1 As String
|
|
157
|
+
bihin1 = ws2.Range("C3").Value
|
|
158
|
+
|
|
159
|
+
'購入品の種類2を取得
|
|
160
|
+
Dim bihin2 As String
|
|
161
|
+
bihin2 = ws2.Range("C4").Value
|
|
162
|
+
|
|
163
|
+
'開始日と終了日を取得
|
|
164
|
+
Dim startdate As Date, enddate As Date
|
|
165
|
+
startdate = ws2.Range("C5").Value
|
|
166
|
+
enddate = ws2.Range("C6").Value
|
|
167
|
+
|
|
168
|
+
|
|
169
|
+
'検索項目が空欄か判定
|
|
170
|
+
Dim flag(4) As Boolean ' BooleanのDefault値はFalse
|
|
171
|
+
If torihiki = "" Then flag(0) = True
|
|
172
|
+
If rokasenn = "" Then flag(1) = True
|
|
173
|
+
If kasyo = "" Then flag(2) = True
|
|
174
|
+
If startdate = 0 Then flag(3) = True
|
|
175
|
+
If enddate = 0 Then flag(4) = True
|
|
176
|
+
|
|
177
|
+
'変数の初期化
|
|
178
|
+
Dim n As Long: n = 12
|
|
179
|
+
|
|
180
|
+
'条件に合致した行を抽出
|
|
181
|
+
Dim i As Long
|
|
182
|
+
For i = 3 To cmax1
|
|
183
|
+
If flag(0) = False Then
|
|
184
|
+
If InStr(1, ws1.Range("C" & i).Value, torihiki, vbTextCompare) = 0 Then: GoTo Continue
|
|
185
|
+
End If
|
|
186
|
+
|
|
187
|
+
If flag(1) = False Then
|
|
188
|
+
If InStr(1, ws1.Range("E" & i).Value, bihin1, vbTextCompare) = 0 Then: GoTo Continue
|
|
189
|
+
End If
|
|
190
|
+
|
|
191
|
+
If flag(2) = False Then
|
|
192
|
+
If InStr(1, ws1.Range("F" & i).Value, bihin2, vbTextCompare) = 0 Then: GoTo Continue
|
|
193
|
+
End If
|
|
194
|
+
|
|
195
|
+
If flag(3) = False Then
|
|
196
|
+
If ws1.Range("J" & i).Value < startdate Then: GoTo Continue
|
|
197
|
+
End If
|
|
198
|
+
|
|
199
|
+
If flag(4) = False Then
|
|
200
|
+
If ws1.Range("J" & i).Value >= enddate Then: GoTo Continue
|
|
201
|
+
End If
|
|
202
|
+
|
|
203
|
+
'条件に合致した行のデータのみを対象して分析
|
|
204
|
+
ws2.Range("A" & n & ":M" & n).Value = ws1.Range("A" & i & ":M" & i).Value
|
|
205
|
+
n = n + 1
|
|
206
|
+
|
|
207
|
+
'プログラム9で条件に合致しなかった場合、ここへジャンプ
|
|
208
|
+
Continue:
|
|
209
|
+
Next
|
|
210
|
+
|
|
211
|
+
'合計値と件数を出力
|
|
212
|
+
Range("C8").Value = Application.WorksheetFunction.CountA(Range("A12:A1048576"))
|
|
213
|
+
|
|
214
|
+
'プログラム終了
|
|
215
|
+
End Sub
|
|
216
|
+
|
|
217
|
+
Sub delete()
|
|
218
|
+
|
|
219
|
+
'シート設定
|
|
220
|
+
Dim ws2 As Worksheet
|
|
221
|
+
Set ws2 = ThisWorkbook.Worksheets("検索と抽出")
|
|
222
|
+
Dim cmax2 As Long
|
|
223
|
+
|
|
224
|
+
ws2.Range("C2,C3,C4,C5,C6,C8").ClearContents
|
|
225
|
+
If Not cmax2 = 11 Then: ws2.Range("A12:M10000" & cmax2).ClearContents
|
|
226
|
+
|
|
227
|
+
End Sub
|
|
228
|
+
|
|
229
|
+
```
|
|
230
|
+
また、再度のご質問となり申し訳ございませんが、下記コードで抽出・転記していると思うのですが、マスターデータのテーマを使用してすべてを貼り付けたいので、「xlPasteAllUsingSourceTheme」に書き換えたいのですが、うまくいきません…。
|
|
231
|
+
こちらも併せてご教示いただけますと嬉しく思います。
|
|
232
|
+
何卒宜しくお願い申し上げます。
|
|
233
|
+
|
|
234
|
+
```ここに言語を入力
|
|
235
|
+
'条件に合致した行のデータのみを対象して分析
|
|
236
|
+
ws2.Range("A" & n & ":M" & n).Value = ws1.Range("A" & i & ":M" & i).Value
|
|
237
|
+
n = n + 1
|
|
238
|
+
```
|
2
タイトル変更
title
CHANGED
|
@@ -1,1 +1,1 @@
|
|
|
1
|
-
VBAでの部分一致検索の仕方
|
|
1
|
+
VBAでの部分一致検索の仕方
|
body
CHANGED
|
File without changes
|
1
試してみたことの修正
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -98,8 +98,28 @@
|
|
|
98
98
|
```
|
|
99
99
|
|
|
100
100
|
### 試したこと
|
|
101
|
+
```ここに言語を入力
|
|
102
|
+
'プログラム9｜条件に合致した行を抽出
|
|
103
|
+
Dim i As Long
|
|
104
|
+
For i = 2 To cmax1
|
|
105
|
+
If flag(0) = False Then
|
|
106
|
+
If ws1.Range("C" & i).Value < startdate Then: GoTo Continue
|
|
107
|
+
End If
|
|
108
|
+
|
|
109
|
+
If flag(1) = False Then
|
|
110
|
+
If ws1.Range("C" & i).Value >= enddate Then: GoTo Continue
|
|
111
|
+
End If
|
|
112
|
+
|
|
113
|
+
If flag(2) = False Then
|
|
114
|
+
If ws1.Range("E" & i) <> torihiki Then: GoTo Continue
|
|
115
|
+
End If
|
|
116
|
+
```
|
|
101
117
|
|
|
102
|
-
上記コード内のプログラム9に該当する箇所をfind関数に直してみたりしましたが、他のプログラムが動作しなくなってしまいました。
|
|
103
118
|
|
|
119
|
+
上記コード内のプログラム9のtorihiki部分を>torihiki にしてみたり、>1にしてみたりしました。
|
|
120
|
+
色々調べてみたのですが、関連した項目を見つけられず、数学的な考えで＞が含む、
|
|
121
|
+
＞1が何かしらの値・文字が入っていればという意味合いなのかなと思い試してみたのですが、
|
|
122
|
+
余計に訳が分からなくなり、今に至ります。
|
|
104
123
|
|
|
124
|
+
分かりにくい上に丸投げになっているように捉えられかねない内容となってしまっているかもしれませんが、皆様のお力をお借りしたく思います。
|
|
105
|
-
|
|
125
|
+
何卒宜しくお願い致します。
|