• ベストアンサー

同じ様式の表の複数シートから行ごと抽出

A2:K12の範囲に表がある全く同じ様式のシートが複数あります。 特定の条件が満たされた行を全て別シートに抽出したいです。 1列目と2列目とX列目(これは集計のA1セルに入った値を参照)が空白でない行を全て抽出したいです。1列目と2列目は1行目から順番に埋まっているのですが、X列目は空白になっているものと空白でないものが混在しています。 たとえば、Xが10列目のときは、Aさん、Bさん、Cさん、Dさん、Eさんの行が抽出されるようにしたいです。 VBAのコードを自力で書けないので、よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

質問者が選んだベストアンサー

  • ベストアンサー
  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.2

こうでしょうか? Sub Sample1()  Dim shCnter As Long  Dim PutRCnt As Long  Dim RCnt As Long  Dim PicColNum As Long    Const PutShNum = 1 '集計先シート番号  Const GetShNumS = 2 '集計元シート群の先頭シート番号  Const GetShNumE = 4 '集計元シート群の末尾シート番号    PicColNum = ThisWorkbook.Sheets(PutShNum).Cells(1, 1).Value    With ThisWorkbook   PutRCnt = 2   For shCnter = GetShNumS To GetShNumE    For RCnt = 2 To 12     If ((.Sheets(shCnter).Cells(RCnt, 1).Value <> "") And _       (.Sheets(shCnter).Cells(RCnt, 2).Value <> "") And _       (.Sheets(shCnter).Cells(RCnt, PicColNum).Value <> "")) Then      .Sheets(shCnter).Rows(RCnt).Copy .Sheets(PutShNum).Rows(PutRCnt)      PutRCnt = PutRCnt + 1     End If    Next RCnt   Next shCnter  End With End Sub

rty145
質問者

お礼

ご回答ありがとうございます。

すると、全ての回答が全文表示されます。

その他の回答 (1)

回答No.1

【参考意見】  当方、先日までエクセルは開いたことも操作したこともない70歳になる爺です。ですから、エクセルのVBAなんて見たことも聞いたこともないド素人。その点を踏まえた私の回答を一瞥ください。  質問の案件ですが、これは、(ある種のツールを使えば)VBAコードを書かずとも可能かと思います。でも、問題は、そのツールのソースコードの受け渡しの手段。多分、OKWaveが許可する行数では足りないでしょう。少なくとも、A4で7~8ページにはなるでしょうから・・・。  一体、そのようなツールを使えば良いのかは、私のプロフィールで公開しているブログをチラリと覗いてください。  一切のVBAコードを書かずとも可能・・・と言うことは、逆に言えば、《VBAコードを書かずとも可能にする命令文を書ける》と言うことが要求されます。なお、ブログ記事《No.16》で提示しているマクロぐらいは書けることは必要です。 Sub Test1()   Dim strSQL0 As String   Dim strSQL1 As String   Dim strSQL2 As String      strSQL1 = "SELECT * FROM [Sheet10$A1:C3] WHERE Len([Sheet10$A1:C3].列2 & '') >0"   strSQL2 = "SELECT * FROM [Sheet11$A1:C3] WHERE Len([Sheet11$A1:C3].列2 & '') >0"   strSQL0 = strSQL1 & " UNION " & strSQL2      Call SQLWriter(strSQL0, "Sheet12$A1") End Sub Sub Test2()   Dim strSQL1 As String   Dim strSQL2 As String      strSQL1 = "SELECT * FROM [Sheet10$A1:C3] WHERE Len([Sheet10$A1:C3].列2 & '') >0"   strSQL2 = "SELECT * FROM [Sheet11$A1:C3] WHERE Len([Sheet11$A1:C3].列2 & '') >0"      Call SQLWriter(strSQL1, "Sheet12$A1")   Call SQLWriter(strSQL2, "Sheet12$A1;ADD") End Sub  なお、マクロのTest1()とTest2()の実行結果は、微妙に違います。まあ、こういうやり方もあるってことです。

rty145
質問者

お礼

ご回答ありがとうございます。

すると、全ての回答が全文表示されます。

関連するQ&A

専門家に質問してみよう