「ExcelVBA複数条件一致後別シートに結果表示」という質問を以前させていただき、丁寧にコードを解説していただきました。 ※その節はありがとうございました。 ●ファイルの内容(概要)配下の通りの構成です。 ＜Sheet1＞ A列：性別(男性:1、女性:2でコード化) B列：死因コード(数値5～6桁) C列：年齢 D列：市町村(3桁でコード化「201」等) ＜Sheet2＞Sheet1で条件に一致したものを以下の通り表を作成する ・「セルA1」に表にしたい市町村コードをあらかじめ入力しておく ・セルB1～セルEC1まで死因コード ・セルA2～セルA132まで年齢0～130 ・セル範囲B2～EC132に「A1」に入力した市町村コードの男性の値が入る ・セルB133～セルEC133まで死因コード ・セルA134～A264まで年齢0～130 ・セル範囲B134～EC264に「A1」に入力した市町村コードの女性の値が入る そして、以下のコードを教えていただきました。 **************************************************** Dim r As Long Dim i As Integer, j As Integer, k As Integer Dim Wsf As Object Dim SCode As Range, Nenrei As Range Dim Ws1 As Worksheet, Ws2 As Worksheet Set Ws1 = Worksheets("sheet1") Set Ws2 = Worksheets("sheet2") Set Wsf = Application.WorksheetFunction Application.ScreenUpdating = False Ws2.Range(Ws2.Cells(2, 2), Ws2.Cells(132, 133)).ClearContents Ws2.Range(Ws2.Cells(134, 2), Ws2.Cells(264, 133)).ClearContents With Ws2 Set SCode = .Range(.Cells(1, 1), .Cells(1, 133)) ↑ここはこのように書いていただいたのから、 指定の死因分類があったためシートから参照するようコードを変えています。 手元にファイルが無くてかけないのが初心者の情けないところです。 申し訳ありません。※シートは同一ファイル内におくようにしています。 End With r = 2 Do While Ws1.Cells(r, 1).Value <> "" If Ws1.Cells(r, 4).Value = Ws2.Cells(1, 1).Value Then If Ws1.Cells(r, 1).Value = 1 Then i = 1 ElseIf Ws1.Cells(r, 1).Value = 2 Then i = 134 End If With Ws2 Set Nenrei = .Range(.Cells(i, 1), .Cells(i + 130, 1)) End With j = i + Wsf.Match(Ws1.Cells(r, 3).Value, Nenrei, 0) - 1 k = Wsf.Match(Ws1.Cells(r, 2).Value, SCode, 0) Ws2.Cells(j, k).Value = Ws2.Cells(j, k).Value + 1 Else End If r = r + 1 Loop Application.ScreenUpdating = True Set Scode = Nothing Set Nenrei = Nothing Set Wsf = Nothing Set Ws1 = Nothing Set Ws2 = Nothing End Sub **************************************************** 表はあらかじめ作成しておくので、そこに集計結果が入ります。 実行していたら、古いファイルに不詳の死因コードが登場し、 どうしたらいいかと考えた結果、死因コードの列の最後に「その他」を設け、 死因コードに一致しない場合にはそこに集計結果をカウントすることは できないか？という考えに至りました。 自分で考えるのが一番勉強になると分かっていても試行錯誤している時間が無く、 急ぎのためお知恵のある方々にご協力を頂ければと思い、 再度質問させていただいた次第です。 前の質問は↓こちらです。 http://okwave.jp/qa/q8356291.html 何卒よろしくお願い申し上げます。
↧