ExcelVBAで複数条件一致の時の抽出法方を教えて下さい。
ここで教えていただいたコードがあるのですが、質問の仕方が悪かったのか、意図した結果が得られず、改変もできなかったので再質問です。よろしくお願い致します。
質問をすることは会社の許諾を得ているのですが、会社のPCからは制限がかかっており投稿できないのでスマホからです。なるべく伝わりやすいよう努めますが、力不足なときはお許し下さい。
Excelのオートフィルタ機能でもよいとも思ったのですが、処理数が100を越えるため、VBAを検討することにしました。
(1)処理前の並び順と、VBAで処理した後の並び順は異なります。
処理前:コードの昇順
処理後:地域ごとに表を作成し、更に広域ごとに表を掲載するシートを分ける
(2)処理前の表は数字しか並んでいません。全てコード化しています。
(3)処理前はいくつもの地域の男女の値が表になっていますが、
・地域コード
・性別コード
・年代コード
・疾患コード
で抽出して、表を作る方法を教えて下さい。1つの地域を抽出する方法で良いのでお願い致します。
後は表を配置する場所と地域コードを指定して、自力で頑張ります。
<元データ>
---|-A-|-B-|-C-|-D-|-E-|-F-|-G-|
列|地域| 性 | 年 | 21 | 22 | 23| 24 |
01| 201 | 1 | 40 | 1 | 2 | 3 | 4 |
02| 201 | 1 | 50 | 2 | 4 | 2 | 1 |
03| 201 | 1 | 55 | 3 | 0 | 0 | 7 |
04| 201 | 1 | 65 | 2 | 1 | 1 | 6 |
05| 201 | 1 | 80 | 1 | 2 | 4 | 1 |
06| 201 | 1 | 95 | 7 | 5 | 4 | 3 |
07| 201 | 2 | 45 | 0 | 3 | 3 | 0 |
08| 201 | 2 | 60 | 4 | 2 | 2 | 6 |
09| 201 | 2 | 70 | 1 | 2 | 3 | 4 |
10| 201 | 2 | 75 | 3 | 6 | 0 | 3 |
11| 201 | 2 | 85 | 5 | 2 | 4 | 2 |
12| 201 | 2 |100| 2 | 2 | 1 | 0 |
13| 202 | 1 | 40 | 1 | 2 | 3 | 4 |
14| 202 | 1 | 45 | 3 | 5 | 2 | 7 |
15| 202 | 1 | 55 | 1 | 2 | 3 | 2 |
…続く
・A列は地域コードです。
・B列は性別コードです。男性が「1」女性が「2」です。
・C列は年代コードです。
40/45/50/55/60/65/70/75/80/85/90/95/100
という形に40から100まで5歳刻みです。
・D列~G列は疾病コードです。
<希望>
・元データの年代は値がないと表示がありません。ですが、出力される表には全ての年代を表示させるのが希望です。
<処理後の表>
VBA実行後は、以下のような表が1つ作成できることが希望です。教えていただいたコードを元に、配置場所を変更できるようになっていると大変ありがたいです。
01| 201 |----| 21 | 22 | 23 | 24 |合計|
02|男性 | 40 | 1 | 2 | 3 | 4 | 10 |
03|男性 | 45 |-----|-----|-----|----| 0 |
04|男性 | 50 | 2 | 4 | 2 | 1 | 9 |
05|男性 | 55 | 3 | 0 | 0 | 7 | 10 |
06|男性 | 60 |-----|-----|-----|----| 0 |
07|男性 | 65 | 2 | 1 | 1 | 6 | 10 |
08|男性 | 70 |-----|-----|-----|----| 0 |
09|男性 | 75 |-----|-----|-----|----| 0 |
10|男性 | 80 | 1 | 2 | 4 | 1 | 8 |
11|男性 | 85 |-----|-----|-----|----| 0 |
12|男性 | 90 |-----|-----|-----|----| 0 |
13|男性 | 95 | 7 | 5 | 4 | 3 | 19 |
14|男性 |100|-----|-----|-----|----| 0 |
15|男性 |合計| 16 | 14 | 14 | 22| 66 |
16|女性 | 40 |-----|-----|-----|----| 0 |
17|女性 | 45 | 0 | 3 | 3 | 0 | 6 |
18|女性 | 50 |-----|-----|-----|-----| 0 |
19|女性 | 55 |-----|-----|-----|-----| 0 |
20|女性 | 60 | 4 | 2 | 2 | 6 | 14 |
21|女性 | 65 |-----|-----|-----|-----| 0 |
22|女性 | 70 | 1 | 2 | 3 | 4 | 10 |
23|女性 | 75 | 3 | 6 | 0 | 3 | 12 |
24|女性 | 80 |-----|-----|-----|-----| 0 |
25|女性 | 85 | 5 | 2 | 4 | 2 | 13 |
26|女性 | 90 |-----|-----|-----|-----| 0 |
27|女性 | 95 |-----|-----|-----|-----| 0 |
28|女性 |100| 2 | 2 | 1 | 0 | 5 |
29|女性 |合計| 15 | 17 | 13 | 15 | 60 |
こんな表にしたいです。
縦横のそれぞれの合計が出せると素敵です。
お知恵を拝借したく、何卒、よろしくお願い致します。
No.3ベストアンサー
- 回答日時:
やりたい事と少し方向性が違うかもしれませんが、PivotTableを使ったアプローチ。
1)ActiveWorkbookに対して処理を行う。
2)ActiveWorkbookに「元データ」という名前のシートがあり、データはそのA1セルが起点。
3)A列は空白セルがない連続データであり、データ行数をA列の個数で判断できる。
4)1行目は空白セルがない連続データであり、データ列数を1行目の個数で判断できる。
5)A1:C1セルに "地域","性","年" という項目名がある。
以上を前提条件とします。
Sub Macro1()
Dim pt As PivotTable
Dim i As Long
With ActiveWorkbook
.Names.Add Name:="database", RefersToR1C1:="=INDEX(元データ!R1,COUNTA(元データ!R1)):INDEX(元データ!C1,COUNTA(元データ!C1))"
Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:="database").CreatePivotTable("")
End With
pt.AddFields RowFields:=Array("性", "年"), ColumnFields:="データ", PageFields:="地域"
For i = 4 To Range("database").Columns.Count
pt.AddDataField pt.PivotFields(i), , xlSum
Next
With pt.PivotFields("性")
.PivotItems("1").Caption = "男性"
.PivotItems("2").Caption = "女性"
.ShowAllItems = True
End With
pt.PivotFields("年").ShowAllItems = True
End Sub
この回答への補足
ありがとうございます。ですが、全ての合計を出したいのではなく、1つの地域コードを指定して、表を作成したいのです。ピポットテーブルは検討しましたが、100近くある地域コードについてそれぞれやるのには不向きと思い止めた経緯があります。
補足日時:2014/02/03 17:46地域コードが選択できることに気づきませんでした(^_^;)スミマセン…ちょっと手間ですが、形式を指定して貼付で「値だけ」にして地道に表をレイアウトしていきたいと思います。ちょっと急ぎなので、この回答が今の私に一番良さそうです。発想の転換でした!ありがとうございました!
No.4
- 回答日時:
No.1.2です。
たびたびごめんなさい。
各地域ごとで男女別の合計が必要なのですね!
前回は単に総合計だけでしたので、無視して↓のコードにしてください。
今回もSheet3を作業用のSheetとして使用しています。
Sheet1のデータは2行目以降にあるとします。
Sub Sample2()
Dim i As Long, j As Long, k As Long, endRow As Long
Dim c As Range, myRange As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
wS2.Cells.Clear
With Worksheets("Sheet3")
wS1.Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").SpecialCells(xlCellTypeVisible).Copy .Range("A1")
wS1.ShowAllData
wS1.Range("B1").Resize(, 6).Copy .Range("C1")
.Range("I1") = "合計"
.Range("A1").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
For k = 2 To 14
.Cells(k, "B") = (k - 2) * 5 + 40
Next k
.Cells(15, "D") = "合計"
Set myRange = .Range("C2:H14")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
.Range("C1") = .Cells(i, "A")
wS1.Range("A1").AutoFilter field:=1, Criteria1:=.Cells(i, "A")
wS1.Range("A1").AutoFilter field:=2, Criteria1:="1"
.Range("C15") = .Cells(i, "A") & "男性"
Range(wS1.Cells(1, "A"), wS1.Cells(endRow, "G")).SpecialCells(xlCellTypeVisible).Copy .Range("J1")
For k = 2 To 14
Set c = .Range("L:L").Find(what:=.Cells(k, "B"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(c.Row, "K").Resize(, 6).Copy .Cells(k, "C")
Else
.Cells(k, "C") = 1
.Cells(k, "D") = .Cells(k, "B")
End If
Next k
With .Range("I2:I14")
.Formula = "=SUM(E2:H2)"
.Value = .Value
End With
With .Range("E15:I15")
.Formula = "=SUM(E2:E14)"
.Value = .Value
End With
.Range("C1:I15").Copy wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Range("J1:P14").ClearContents
myRange.ClearContents
wS1.Range("A1").AutoFilter field:=1, Criteria1:=.Cells(i, "A")
wS1.Range("A1").AutoFilter field:=2, Criteria1:="2"
.Range("C15") = .Cells(i, "A") & "女性"
Range(wS1.Cells(1, "A"), wS1.Cells(endRow, "G")).SpecialCells(xlCellTypeVisible).Copy .Range("J1")
For k = 2 To 14
Set c = .Range("L:L").Find(what:=.Cells(k, "B"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(c.Row, "K").Resize(, 6).Copy .Cells(k, "C")
Else
.Cells(k, "C") = 2
.Cells(k, "D") = .Cells(k, "B")
End If
Next k
With .Range("I2:I14")
.Formula = "=SUM(E2:H2)"
.Value = .Value
End With
With .Range("E15:I15")
.Formula = "=SUM(E2:E14)"
.Value = .Value
End With
.Range("C2:I15").Copy wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Range("J1:P14").ClearContents
myRange.ClearContents
Next i
wS1.AutoFilterMode = False
.Cells.Clear
End With
With wS2.Range("A:A")
.Replace what:=1, replacement:="男性", lookat:=xlWhole
.Replace what:=2, replacement:="女性", lookat:=xlWhole
End With
With wS2
.Rows(1).Delete
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Columns.AutoFit
End With
Application.ScreenUpdating = True
wS2.Select
MsgBox "処理完了"
End Sub
※ すべての地域を羅列するようにしていますので、
時間を要すると思います。m(_ _)m
ありがとうございます。せっかく書いていただきましたが、表しか作成されませんでした(;_;)それと、表を羅列したいのではなく、地域コードを指定して1つだけ表を作りたいのです。総数を出したいのは書いていただいたとおり希望ですが、それはどうにかなるので、1つの地域コードを指定して表を出力するにはどうしたらいいのか教えて下さい_(._.)_
No.2
- 回答日時:
続けて・・・後半部分です。
wS3.Range("B1:H14").Copy wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
myRange.ClearContents
wS3.Range("I:O").Clear
.AutoFilter field:=2, Criteria1:=2
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow, "G")).Copy wS3.Range("I1")
For k = 2 To 14
Set c = wS3.Range("K:K").Find(what:=wS3.Cells(k, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
wS3.Cells(c.Row, "J").Resize(, 6).Copy wS3.Cells(k, "B")
Else
With wS3.Cells(k, "B")
.Value = 2
.Offset(, 1) = wS3.Cells(k, "A")
End With
End If
Next k
With wS3.Range("H2").Resize(13)
.Formula = "=SUM(D2:G2)"
.Value = .Value
End With
wS3.Range("B2:H14").Copy wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
myRange.ClearContents
wS3.Range("I:O").Clear
End With
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
With wS2
.Rows(1).Delete
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(endRow, "A").Offset(1) = "合計"
Set c = Range(.Cells(1, "A"), .Cells(endRow, "A"))
For k = 3 To 7
Set myRange = Range(.Cells(1, k), .Cells(endRow, k))
.Cells(endRow + 1, k) = WorksheetFunction.SumIf(c, 1, myRange) + _
WorksheetFunction.SumIf(c, 2, myRange)
Next k
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A:A").Replace what:=1, replacement:="男性", lookat:=xlWhole
.Range("A:A").Replace what:=2, replacement:="女性", lookat:=xlWhole
End With
Application.ScreenUpdating = True
wS2.Select
MsgBox "処理完了"
End Sub
じっくり考えればもっと簡単になるかもしれませんが、
とりあえずはこの程度で・・・m(_ _)m
ありがとうございます。試してみたのですが、表はきれいにできるのですが、結果は抽出されませんでした。それと、表は地域コード1つだけで作りたいので、羅列はしなくてよいのです。説明が下手で申し訳ありません_(._.)_1つだけで出力するにはどうしたらよいか、教えていただけますと幸いです。
No.1
- 回答日時:
こんばんは!
Sheet1のデータをSheet2に表示するようにしています。、
Sheet見出し上には3つSheetがあり、Sheet3は使用していない状態にしておいてください。
Sheet1は1行目が項目行でデータは2行目以降にあるとします。
↓のコードを標準モジュールにコピー&ペーストしてマクロを実行してみてください。
ただ、ダラダラと長いコードになってしまいましたので、
2回に分けて投稿します。
まず前半部分
Sub Sample1()
Dim i As Long, k As Long, endRow As Long
Dim c As Range, myRange As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
wS2.Cells.Clear
wS1.Range("B1").Resize(, 6).Copy wS3.Range("B1")
wS3.Range("H1") = "合計"
For i = 2 To 14
wS3.Cells(i, "A") = 40 + (i - 2) * 5
Next i
Set myRange = wS3.Range("B2:H14")
wS1.Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(2, "A"), wS1.Cells(endRow, "A")).Copy wS3.Range("A16")
wS1.ShowAllData
For i = 16 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
wS3.Range("B1") = wS3.Cells(i, "A")
With wS1.Range("A1")
.AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
.AutoFilter field:=2, Criteria1:=1
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow, "G")).Copy wS3.Range("I1")
For k = 2 To 14
Set c = wS3.Range("K:K").Find(what:=wS3.Cells(k, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
wS3.Cells(c.Row, "J").Resize(, 6).Copy wS3.Cells(k, "B")
Else
With wS3.Cells(k, "B")
.Value = 1
.Offset(, 1) = wS3.Cells(k, "A")
End With
End If
Next k
With wS3.Range("H2").Resize(13)
.Formula = "=SUM(D2:G2)"
.Value = .Value
End With
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
フェラする時に、男に喉奥まで...
-
首吊りに使われる縄は太いほど...
-
風俗には何歳ぐらいまで、行っ...
-
性行為の時、女性の膣の奥にあ...
-
50代男性です。彼女も50代のW不...
-
既婚男性が、何回以上、特定の...
-
レズじゃないけど女と性的な事...
-
女性は何歳頃まで感じることが...
-
ソープに行った夫。私が取るべ...
-
妻が元風俗嬢なのですが、仕事...
-
我慢汁が出ない彼氏※下ネタです...
-
ソープは基本ゴムあり挿入だと...
-
セフレと別れて後悔
-
結婚して10年近く経っている...
-
女性はなぜ喘ぐんですか?
-
我慢汁ってどうゆうときにでる...
-
お互い初エッチてどのような流...
-
AV観るのにSEXしないのはなぜで...
-
女の子の体って何であんなにフ...
-
男性は貧乳でも興奮するんです...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
フェラする時に、男に喉奥まで...
-
首吊りに使われる縄は太いほど...
-
風俗には何歳ぐらいまで、行っ...
-
性行為の時、女性の膣の奥にあ...
-
レズじゃないけど女と性的な事...
-
50代男性です。彼女も50代のW不...
-
ソープは基本ゴムあり挿入だと...
-
女性は何歳頃まで感じることが...
-
男はSEXを拒否されると、ど...
-
既婚男性が、何回以上、特定の...
-
女性はなぜ喘ぐんですか?
-
お互い初エッチてどのような流...
-
結婚して10年近く経っている...
-
女の子の体って何であんなにフ...
-
我慢汁が出ない彼氏※下ネタです...
-
セフレと別れて後悔
-
ソープに行った夫。私が取るべ...
-
くだらない質問ですがすみませ...
-
妻が元風俗嬢なのですが、仕事...
-
連れ子との行為について。 私は...
おすすめ情報