アプリ版:「スタンプのみでお礼する」機能のリリースについて

VBA で抽出したデータが一定数まできたら、異なるセルに折り返して抽出するように設定したいです。

◇シート1◇ ※元データ
 A      B     C     D    
1| 氏名 役職 部署 年齢     
――――――――――――――――
2| 山田 社員 開発 45 
3| 田中 社員 人事 42  
4| 鈴木 派遣 企画 30  
5| 高橋 役員 人事 50
6| 坂野 社員 企画 33  
7| 井上 派遣 企画 29

◇シート2◇ 
条件1.役職は"役員"で、部署が"人事"の人の
  氏名、役職、部署をA3から順に抽出する

条件2.A列のデータが9行目まできたら
    D3に抽出されるようにする

 A      B     C     D     E    F
1 氏名 役職 部署  氏名 役職 部署
2 高橋 役員 人事  
3
4
5
6
7
8
9
――――――――――――――――――――


ちなみにこのサイトで以下のコードを作成してもらいましたが
これだとデータ元の全ての行が抽出されてしまいます。

Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
.Range("A1:E1").AutoFilter
.Range("A1:E1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="人事"
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A3")
.AutoFilterMode = False
End With
End Sub

条件2のデータを折り返す条件が難しいようであれば
条件1の3列のみ抽出する方法で結構ですので教えてください。
よろしくお願いします。

A 回答 (4件)

なんか複雑なことを考えておられるようですが、要するにそのマクロを


使って一旦「シート3」に全項目の該当するレコードを引っ張り出し、
「シート2」は「シート3」の所要の項目を式で参照すれば済む話では
ないんでしょうか?

マクロに慣れると全部をマクロでやりたくなりますが、せっかくExcel
には「関数」という便利なものがあるんですから、使わない手はないかと。
    • good
    • 0
この回答へのお礼

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

マクロの便利さに感動し、何でもできそうと思いましたが
確かに関数の方が向いているかもしれませんね。
複雑にすると
自分も他のファイル使用者も使いづらくなってしまいますよね。。

関数でもいろいろためしてみます!

急ぎで回答下さったのに、お礼が遅れてしまい、すみませんでした。
ありがとうございました。

お礼日時:2009/03/05 22:54

>条件1の3列のみ抽出する方法



Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
.Range("A1:E1").AutoFilter
.Range("A1:E1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="人事"
Intersect(.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)) _
.SpecialCells(xlCellTypeVisible), .Range("A:C")).Copy Range("A3")
.AutoFilterMode = False
End With
End Sub

一例まで。
    • good
    • 0
この回答へのお礼

ご回答ありがとうござます!

さっそく使用させていただきました。
助かりました!!
他のファイルでも活用できそうです^^

急ぎで回答くださったのに
お礼が遅れて申し訳ございません。
ありがとうございました。

お礼日時:2009/03/05 22:57

おやまたお会いしましたね。



> 条件2.A列のデータが9行目まできたら

A列は3行目から始まるんですよね?
なら9行目とはA10セルまでという意味でいいのかな?

Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
lstRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:C1").AutoFilter
.Range("A1:C1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:C1").AutoFilter Field:=3, Criteria1:="人事"
.Range(.Range("A1"), .Range("C" & lstRow)).SpecialCells(xlCellTypeVisible).Copy Range("A3")
.AutoFilterMode = False
End With
lstRow2 = Range("A" & Rows.Count).End(xlUp).Row
MsgBox lstRow2
If lstRow2 >= 12 Then
Range("D3:F3").Value = Range("A3:C3").Value
Range("A12:C" & lstRow).Cut Range("D4")
End If
End Sub
    • good
    • 0
この回答へのお礼

merlionXXさん、こんばんは。

前回に引き続き、またご回答くださり、ありがとうございます。
さっそく使用させていただきました。
完全にマッチしてくれて、感動しました!

何度も申し訳ないのですが
1点質問です。

データが抽出されたとき
抽出数が記載されたポップアップ(エラー表示のような小さいウィンドウ)が表示されるのですが
これを表示させなくすることはできますか?

OKボタンを押せば消え、ファイルも問題なく使用できるので
もしお時間があるときに
教えていただけると幸いです。

よろしくお願いします。

お礼日時:2009/03/05 23:09

おはようございます、merlionXXです。



> 抽出数が記載されたポップアップ(エラー表示のような小さいウィンドウ)が表示されるのですが

それは失礼しました。
テストで確認用にわたしが余分なものをつけて、そのまま消し忘れていました。
わたしのコードの下から6行目の
MsgBox lstRow2 
という一行を削除してください。
    • good
    • 0
この回答へのお礼

こんばんわ。
メッセージウィンドウ、表示されなくなりました^^
ちょっと調べればわかりそうな事でしたね。。
勉強します!
どうもありがとうございました!

お礼日時:2009/03/06 19:36

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!