エクセルで別シートに情報を抽出

前提・実現したいこと

xmlファイルからエクセルシートへの読み取りまでは出来ました。
実現したいことは、読み取ったエクセルシートからある必要な列を幾つか抜き出す。次に抽出した列の１列にある（○,×）で他の列もそれに紐づくようにしたものを別のシートに書き出す。
１箇所だけを抽出してそれぞれを別シートへ抽出できたのですが、複数抽出ができないこと、また同じシートに転記できないです。

教えて頂けると幸いです。
ここに質問の内容を詳しく書いてください。
（例）PHP(CakePHP)で●●なシステムを作っています。
■■な機能を実装中に以下のエラーメッセージが発生しました。

発生している問題・エラーメッセージ

Sub データ抽出()
Dim ws As String　　
Dim val As String　　
Application.ScreenUpdating = False
ws = "Sheet2"
val = "○"
Call filterData(ws, val)
ws = "Sheet3"
val = "×"
Call filterData(ws, val)
Application.ScreenUpdating = True
MsgBox "処理が完了しました。"
End Sub

エラーメッセージ

該当のソースコード

ソースコードVBA

試したこと

ネット上で幾つかの関数とコードを参考にしてマクロを組んでみたのですが上手く行かないです。
ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

ベストアンサー

質問の内容とご提示いただいているコードについて

Call filterData(ws, val)の部分を開示してくださるとよいかと思います。

xmlファイルからエクセルシートへの読み取りまでは出来ました。

→手作業でしょうか・・。

表についてもご提示いただけるとよいかと思います。

例を示します。サンプルはA列が〇か×かを判定し、sheet2、sheet3に情報を転記するサンプルです。
転記するリストは、商品名と産地です。

例）Excelシート名：data、sheet2、sheet3

シート：data
A～D列
|判定|商品|価格|産地|
|:--|:--:|--:|
|〇|A|100|宮城県|
|×|B|200|山形県|
|〇|C|300|北海道|
|〇|D|400|広島県|
|〇|E|500|青森県|
|〇|F|600|沖縄県|
|〇|G|700|福島県|

VBA
1Sub test()
2Dim MaxRow As Double
3Dim 判定 As String
4Dim　i as Double
5Dim sh2 As Double
6Dim sh3 As Double
7
8
9MaxRow = Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
10
11
12For i = 2 To MaxRow
13    
14      判定 = Sheets("data").Range("A" & i)
15
16    If 判定 = "〇" Then
17    
18        sh2 = sh2 + 1
19        
20        With Sheets("Sheet2")
21            
22            .Range("A" & sh2).Value = Sheets("data").Range("B" & i) '商品
23            .Range("B" & sh2).Value = Sheets("data").Range("D" & i) '産地
24            
25        End With
26        
27
28   
29     ElseIf 判定 = "×" Then
30   
31        sh3 = sh3 + 1
32        
33        
34        
35         With Sheets("Sheet3")
36            .Range("A" & sh3).Value = Sheets("data").Range("B" & i) '商品
37            .Range("B" & sh3).Value = Sheets("data").Range("D" & i) '産地
38        
39        End With
40        
41    End If
42    
43
44
45
46Next
47
48
49End Sub

データ便にUPしたファイルが間違っておりました。下記に修正をお願いします。
下記の部分をsh2→sh3に修正をお願いします。

     With Sheets("Sheet3")
        .Range("A" & sh3).Value = Sheets("data").Range("B" & i) '商品
        .Range("B" & sh3).Value = Sheets("data").Range("D" & i) '産地
    
    End With

投稿2020/08/04 06:06

編集2020/08/04 07:53

mako1972

総合スコア383

Feng19

2020/08/04 07:21

回答ありがとうございます。xmlからエクセルは自動で行いました。表が事情により提示できないため代用でも良いでしょか

mako1972

2020/08/04 07:39

データ便にUPしておきました。必要でしたら・・。 https://www.datadeliver.net/receiver/file_box.do?fb=fcbc7efb48404fa9a6988dee456cace2&rc=411e37f5bda8482e82aa5afb7111aa85&lang=ja

mako1972

2020/08/04 08:05 編集

これにベースに、if文を追加して、産地がXXだったらとか追加していただけると複数条件になると思います。また、抜き出す項目（列）についてもコードを検証していただけると指定できると思います。

Feng19

2020/08/04 07:58

これからコードを書いて試してみます。本当にありがとうございます。

mako1972

2020/08/04 08:01

データ便にUPしたファイルは修正部分がありますので、本レスの回答のコード部分を参照してくださいますようお願いします。

Feng19

2020/08/05 02:21 編集

コードを入れたのですがエラー表示出ることなくできませんでした。自分でもやり直してみました。 Sub 試作() Dim i As Integer '// ループカウンタ Dim c As Integer Dim count As Integer Dim sum As String '// 取得用列番号 i = 3 '// 空白用列番号 count = 3 '// 空白チェック Do Until Sheets("テンプレート").Cells(count, 1).Value = "" count = count + 1 Loop '// 空白チェック Do Until Sheets("from").Cells(i, 1).Value = "" Sheets("テンプレート").Cells(count, 1).Value = Sheets("from").Cells(i, 30).Value Sheets("テンプレート").Cells(count, 2).Value = Sheets("from").Cells(i, 35).Value Sheets("テンプレート").Cells(count, 3).Value = Sheets("from").Cells(i, 34).Value Sheets("テンプレート").Cells(count, 4).Value = Sheets("from").Cells(i, 61).Value Sheets("テンプレート").Cells(count, 5).Value = Sheets("from").Cells(i, 64).Value Sheets("テンプレート").Cells(count, 6).Value = Sheets("from").Cells(i, 62).Value Sheets("テンプレート").Cells(count, 7).Value = Sheets("from").Cells(i, 65).Value i = i + 1 count = count + 1 Loop End Sub 必要な情報を取り出せることに成功しました。ここからさらに３列目で○か×かで分類をしたものをJ列等で再構成したものを表示るにはどうしたら良いでしょかまた上記のコード以外のやり方があればぜひ教えて頂ければと思います

mako1972

2020/08/05 02:30

表のサンプルを提示していだくと。

mako1972

2020/08/05 02:40 編集

やはりサンプル表をお願いします。

Feng19

2020/08/05 02:44 編集

こんな感じの表です。（必要箇所を抜き出した後になります）果物　　　分布　　数　認知度　品種　　数　認知度りんご　多い　 2 　○ バナナ少ない 3 　× モモ　　　　　　　　＊＊＊　　2 　　○ ビワ　　　　　　　　〇〇　　　　　3 　　○ イチゴ　　　　　　×× 　　　　　4　　　　　× ブルーベリー　　　＄＄＄　　　　5 　　　× 認知度で分類をしたものを開いている列に記載したいです

mako1972

2020/08/05 02:44

今外なのでレスないようでしたら。

Feng19

2020/08/05 02:46

本当にすみません。こんな感じの表です。（必要箇所を抜き出した後になります）果物　　　分布　　数　認知度　品種　　数　認知度りんご　多い　 2 　○ バナナ少ない 3 　× モモ　　　　　　　　＊＊＊　　2 　　○ ビワ　　　　　　　　〇〇　　　　　3 　　○ イチゴ　　　　　　×× 　　　　　4　　　　　× ブルーベリー　　　＄＄＄　　　　5 　　　× 認知度で分類をしたものを開いている列に記載したいです

Feng19

2020/08/05 02:58 編集

表を貼り付けたいのですが貼り付ける方法がわからず、教えてもらうことはできますか

mako1972

2020/08/05 03:03

シートが複数あるようですけど

Feng19

2020/08/05 03:32

シートはひとつです。コメントに表の載せ方が分からずいろんな方法でアップしてしまいました。混乱させてしまいすみません

mako1972

2020/08/05 04:37 編集

>>コードを入れたのですがエラー表示出ることなくできませんでした。そういうことですか。前回のサンプルはお試しになったのでしょうか・・。ループの記述が迷走してますね。 if文も見当たりません・・。if文の中でカウンター変数を使ったのも理解されていないですね・・。 >>データの取得に成功しました。少しあやしいですね。

mako1972

2020/08/05 06:18 編集

>>J列等で再構成したものをとは、提示いただいているどこの部分でしょうか・・・。前後の表を示した方がよいと思います。突然、わからない部分が出てきます・・。認知度も列が2つあります。

Feng19

2020/08/05 07:39

最近VBAを勉強し始めましたのでご指摘の通り理解できておらずすみません。勉強します

mako1972

2020/08/05 07:58 編集

悪いということではないですよ。初学者の方は、急にセル番号を30個以上ある表で作成してみたり、不要なループを使ってはまってみたり、本番投入してはまってみたりすると思います。その状態です。まずは、前後の表を提示（後は提示していただいてますが）していただいた方が間違いを修正できますよという提案です。提示いただいたサンプルですが、前回のサンプルでIf文のコードを追加してみた。とかならわかるのですが、依頼内容の前後の表はだせませんだと厳しそうです・・。助言できない要因として、不要なループをされているので、目的から入らないとコードを修正できないためです。これに懲りずに、引き続き情報をUPしてください。 J列は何か・・・。etc 可能でしたら、この間の表をサンプルについてDo Loop＋IF構文で記述してみてください。

mako1972

2020/08/05 11:19

回答待ち。

Feng19

2020/08/06 06:52

ありがとうございます。分かりました。サンプルで記述してみます

行動規範の内容に同意します