Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4697 / 13644 ツリー ←次へ | 前へ→

【54993】データー抽出とワークシートへの転記 Regina 08/4/9(水) 23:40 質問[未読]
【54995】Re:データー抽出とワークシートへの転記 Yuki 08/4/10(木) 9:40 発言[未読]
【55013】Re:データー抽出とワークシートへの転記 Regina 08/4/11(金) 13:38 発言[未読]
【55015】Re:データー抽出とワークシートへの転記 Regina 08/4/11(金) 13:59 発言[未読]
【55017】Re:データー抽出とワークシートへの転記 Yuki 08/4/11(金) 14:31 発言[未読]
【55031】Re:データー抽出とワークシートへの転記 Regina 08/4/11(金) 17:40 発言[未読]
【55030】Re:データー抽出とワークシートへの転記 ponpon 08/4/11(金) 17:02 発言[未読]
【55032】Re:データー抽出とワークシートへの転記 Regina 08/4/11(金) 18:01 発言[未読]
【55040】Re:データー抽出とワークシートへの転記 Yuki 08/4/12(土) 7:17 発言[未読]
【55042】Re:データー抽出とワークシートへの転記 Regina 08/4/12(土) 8:10 発言[未読]
【55043】Re:データー抽出とワークシートへの転記 Yuki 08/4/12(土) 9:24 発言[未読]
【55047】Re:データー抽出とワークシートへの転記 ponpon 08/4/12(土) 22:08 発言[未読]
【55056】Re:データー抽出とワークシートへの転記 Regina 08/4/13(日) 9:47 発言[未読]
【55058】Re:データー抽出とワークシートへの転記 Regina 08/4/13(日) 9:58 発言[未読]
【55059】Re:データー抽出とワークシートへの転記 ponpon 08/4/13(日) 10:10 発言[未読]
【55081】Re:データー抽出とワークシートへの転記 Regina 08/4/14(月) 18:32 発言[未読]
【55086】Re:データー抽出とワークシートへの転記 ponpon 08/4/14(月) 23:02 発言[未読]
【55117】Re:データー抽出とワークシートへの転記 Regina 08/4/15(火) 17:23 お礼[未読]
【55118】Re:データー抽出とワークシートへの転記 ponpon 08/4/15(火) 21:14 発言[未読]

【54993】データー抽出とワークシートへの転記
質問  Regina  - 08/4/9(水) 23:40 -

引用なし
パスワード
   たびたびお世話になっております。以前、皆様にご指導いただいて、患者データーベースが出来上がってきています。今回、このデーターベースを使用して、データーの抽出と他のワークシートへの転記をしたいと思っています。この抽出されたデーターを他のリストに使用するために、データーの抽出が必要になっています。
===========================================================
  A       B    C     D    E      F
1 患者ID   氏名  性別  生年月日  年齢  入院/外来   
2 12345   山田   女性   ‥    ‥    外来
3 11111   鈴木   男性   …    ‥    入院
4 22222   山下   女性   …    ‥    入院
5 33333   田中   女性   …    ‥    外来
=========================================================
上記のデーターベースより、「F」のフィールドが"入院"の場合は、"抽出入院"と言う名前のワークシートに「B」フィールドの名前のみデーターをコピーし、「F」のフィールドが"外来"の場合は、、"抽出外来"と言う名前のワークシートに「B」フィールドの名前のみデーターをコピー出来るようにしたいです。
データーベースのシートに"抽出"用のボタンを2つ作り(入院用・外来用)、適時更新できるように出来ればと思って、コードを作ってみました。
---------------------------------------------------------------------
Sub 抽出_Click()
 'フィルター実行
 Range("A1").AutoFilter Field:=6, Criteria1:="外来"
 
 'コピー
 Range("A1").CurrentRegion.Copy Destination:=Range("抽出外来!A1")
 'フィルター解除
 Range("A1").AutoFilter
End Sub
----------------------------------------------------------------------
Sub 抽出2_Click()
 'フィルター実行
 Range("A1").AutoFilter Field:=6, Criteria1:="入院"
 
 'コピー
 Range("A1").CurrentRegion.Copy Destination:=Range("抽出入院!A1")
 'フィルター解除
 Range("A1").AutoFilter
End Sub
------------------------------------------------------------------------

上記のマクロを登録してある"抽出"と"抽出2"のボタンをクリックすると、ワークシートの"抽出入院""抽出外来"の2つのシート共に、全データーがコピーされていました(入院/外来で分かれていませんでした)。

オートフィルターの機能として、「フィールドがAだったらデーターを○に転記、フィールドがBだったらデーターを△に転記」すると言うような選択は難しいのでしょうか?

また、オートフィルターで抽出されたデーターの1部分のデーターのみの転記(ここでは氏名のみの転記:山田とか鈴木とか)は出来るのでしょうか?

私の持っている本では、上記のコードレベルまでしか参考に出来ていません。一つのボタンのクリックの動作で、上記内容が出来ればいいのですが、持っている本では、一つの条件のみの抽出若しくは、複数の抽出条件(AND / ORのみ)の指定までしか書いてなかったので、やむを得ず、2つのボタンを入院抽出/外来抽出のボタンとしています。

オートフィルターでも、オートフィルター以外の機能でも構いませんので、コードやヒントを与えていただけると助かります。また、1つのボタンクリックで行いたいと思っています。

度々の質問ですみません。

【54995】Re:データー抽出とワークシートへの転記
発言  Yuki  - 08/4/10(木) 9:40 -

引用なし
パスワード
   ▼Regina さん:

参考に
Sub TEST()
  With Worksheets(1)
    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
    With .AutoFilter.Range
      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
      .SpecialCells(xlCellTypeVisible).Copy _
      Worksheets(抽出外来).Range("A1")
    End With
  End With
End Sub

【55013】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/11(金) 13:38 -

引用なし
パスワード
   ▼Yuki さん:

ありがとうございます。

教えていただいたコードをコマンドボタンに貼り付けて動作確認をしてみました。

デバックエラーとなりました。この、コードを使う場合、With Worksheets(1)のWorksheets(1)の部分をデーターベースという名前にしてみましたが、エラーとなりました。

お忙しいとは思いますが、ご教授ください。

【55015】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/11(金) 13:59 -

引用なし
パスワード
   ▼Yuki さん:
>すみません、詳しく書いていませんでした。

With Worksheets(1)を、With Worksheets("データーベース")として、使用すればよろしいですか?
>
>お忙しいとは思いますが、ご教授ください。

【55017】Re:データー抽出とワークシートへの転記
発言  Yuki  - 08/4/11(金) 14:31 -

引用なし
パスワード
   ▼Regina さん:

>With Worksheets(1)を、With Worksheets("データーベース")として、使用すればよろしいですか?

対象のシート名がデーターベースだったらそれで宜しいですね。
試してみれば分かりますよ。

【55030】Re:データー抽出とワークシートへの転記
発言  ponpon  - 08/4/11(金) 17:02 -

引用なし
パスワード
   ▼Regina さん:
>▼Yuki さん:
>>すみません、詳しく書いていませんでした。
>
>With Worksheets(1)を、With Worksheets("データーベース")として、使用すればよろしいですか?
>>
>>お忙しいとは思いますが、ご教授ください。

Worksheets(抽出外来).Range("A1")
     ↓
Worksheets("抽出外来").Range("A1")

では?

【55031】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/11(金) 17:40 -

引用なし
パスワード
   ▼Yuki さん:
すみません、以下を試したのですが、エラーになって再確認の意味でのお尋ねでした。

>>With Worksheets(1)を、With Worksheets("データーベース")として、使用すればよろしいですか?
>
>対象のシート名がデーターベースだったらそれで宜しいですね。
>試してみれば分かりますよ。

【55032】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/11(金) 18:01 -

引用なし
パスワード
   ▼ponpon さん:
▼Yuki さん:
ご指導ありがとうございます。

お二人からの訂正によりコードの実行をかけました。

.Columns(2).Offset(1).Resize(.Rows.Count - 1)

上記コードが
「実行時エラー 438、オブジェクトは、このプロパティーまたはメソッドをサポートしていません」となりました。

.Columns(2).Offset(1)の(2)と(1)の部分に何か変えて入力しないといけませんか?

初心者質問ですみません。

【55040】Re:データー抽出とワークシートへの転記
発言  Yuki  - 08/4/12(土) 7:17 -

引用なし
パスワード
   ▼Regina さん:

このまま貼り付けて実行してみてください。
Sub TEST()
  With Worksheets("データベース")
    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
    With .AutoFilter.Range
      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
      .SpecialCells(xlCellTypeVisible).Copy _
      Worksheets("抽出外来").Range("A1")
    End With
    .AutoFilterMode = False
  End With
End Sub

データは
患者ID    氏名    性別    生年月日    年齢    入院/外来
12345    山田    女性    ‥    ‥    外来
11111    鈴木    男性    …    ‥    入院
22222    山下    女性    …    ‥    入院
33333    田中    女性    …    ‥    外来

結果
山田
田中

>▼ponpon さん:
フォローありがとう御座います。

【55042】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/12(土) 8:10 -

引用なし
パスワード
   ▼Yuki さん:
おはようございます。お返事ありがとうございます。
教えていただいた、コードを貼り付けて実行しました。

抽出外来のワークシートに「名前」のみ抽出できました。
しかし、外来のみの抽出でなく、全ての名前が抽出されました。

どこか、ブック自体の問題か、「データベース」のワークシート自体の問題でしょうか?お時間の宜しい時にご教授下さい。

【55043】Re:データー抽出とワークシートへの転記
発言  Yuki  - 08/4/12(土) 9:24 -

引用なし
パスワード
   ▼Regina さん:
>しかし、外来のみの抽出でなく、全ての名前が抽出されました。
おかしいですね。

Sub TEST()
  Worksheets("抽出外来").Cells.ClearContents
  With Worksheets("データベース")
    .AutoFilterMode = False
    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
    With .AutoFilter.Range  ' 此処にブレークポイントでフィルターの
                 ' 結果を見てください。 
      .SpecialCells(xlCellTypeVisible).Copy _
      Worksheets("抽出外来").Range("A1")
    End With
    .AutoFilterMode = False
  End With
End Sub
こうするとフィルターされたものが全部シート抽出外来に
張り付きますけど

【55047】Re:データー抽出とワークシートへの転記
発言  ponpon  - 08/4/12(土) 22:08 -

引用なし
パスワード
   ▼Yuki さん:
▼Regina さん:

>おかしいですね。

どちらのコードでもそのまま貼り付けて、
           きちんと抽出されていますよ。
Worksheets("データベース")のレイアウトが違っているのかな?

>Sub TEST()
>  With Worksheets("データベース")
>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>    With .AutoFilter.Range
>      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
>      .SpecialCells(xlCellTypeVisible).Copy _
>      Worksheets("抽出外来").Range("A1")
>    End With
>    .AutoFilterMode = False
>  End With
>End Sub


>
>Sub TEST2()
>  Worksheets("抽出外来").Cells.ClearContents
>  With Worksheets("データベース")
>    .AutoFilterMode = False
>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>    With .AutoFilter.Range  ' 此処にブレークポイントでフィルターの
>                 ' 結果を見てください。 
>      .SpecialCells(xlCellTypeVisible).Copy _
>      Worksheets("抽出外来").Range("A1")
>    End With
>    .AutoFilterMode = False
>  End With
>End Sub

【55056】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/13(日) 9:47 -

引用なし
パスワード
   ▼ponpon さん:

ありがとうございます。

>>Sub TEST()
>>  With Worksheets("データベース")
>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>    With .AutoFilter.Range
>>      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
>>      .SpecialCells(xlCellTypeVisible).Copy _
>>      Worksheets("抽出外来").Range("A1")
>>    End With
>>    .AutoFilterMode = False
>>  End With
>>End Sub
>
上記のコードでは、入院・外来全ての患者さんの名前が抽出されました。
>>
>>Sub TEST2()
>>  Worksheets("抽出外来").Cells.ClearContents
>>  With Worksheets("データベース")
>>    .AutoFilterMode = False
>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>    With .AutoFilter.Range  ' 此処にブレークポイントでフィルターの
>>                 ' 結果を見てください。 
>>      .SpecialCells(xlCellTypeVisible).Copy _
>>      Worksheets("抽出外来").Range("A1")
>>    End With
>>    .AutoFilterMode = False
>>  End With
>>End Sub
この上のコードでは、名前だけでなく、他のデータ(年齢とか)も全てコピーされていました。

データベースは、Fの列が入院・外来のセルになっているので「Field:=6」で合っていると思います。このデータベースはユーザーフォームによって入力・削除できるようにしているので、それに原因があるのでしょうか?入院・外来の部分はユーザーフォーム上のオプションボタンで選択して"入院""外来"が入力されるように設定しています。

【55058】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/13(日) 9:58 -

引用なし
パスワード
   "外来"の部分を"入院"に切り替えてみたら、入院の分だけの氏名のみが抽出されました。
>>>Sub TEST()
>>>  With Worksheets("データベース")
>>>    .Range("A1").AutoFilter Field:=6, Criteria1:="入院"
>>>    With .AutoFilter.Range
>>>      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
>>>      .SpecialCells(xlCellTypeVisible).Copy _
>>>      Worksheets("抽出外来").Range("A1")
>>>    End With
>>>    .AutoFilterMode = False
>>>  End With
>>>End Sub

やはり、データベース自体の問題でしょうか?

【55059】Re:データー抽出とワークシートへの転記
発言  ponpon  - 08/4/13(日) 10:10 -

引用なし
パスワード
   ▼Regina さん:
おはようございます。
>>>Sub TEST()
>>>  With Worksheets("データベース")
>>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>>    With .AutoFilter.Range
>>>      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
>>>      .SpecialCells(xlCellTypeVisible).Copy _
>>>      Worksheets("抽出外来").Range("A1")
>>>    End With
>>>    .AutoFilterMode = False
>>>  End With
>>>End Sub
>>
>上記のコードでは、入院・外来全ての患者さんの名前が抽出されました。

これは、おかしいですね?
入院・外来は、「データベース」のF列に入力されているんでしょう?

>>>
>>>Sub TEST2()
>>>  Worksheets("抽出外来").Cells.ClearContents
>>>  With Worksheets("データベース")
>>>    .AutoFilterMode = False
>>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>>    With .AutoFilter.Range  ' 此処にブレークポイントでフィルターの
>>>                 ' 結果を見てください。 

             ここで、「外来」だけが抽出されてますか?
            
>>>      .SpecialCells(xlCellTypeVisible).Copy _
>>>      Worksheets("抽出外来").Range("A1")
>>>    End With
>>>    .AutoFilterMode = False
>>>  End With
>>>End Sub
>この上のコードでは、名前だけでなく、他のデータ(年齢とか)も全てコピーされていました。
>
これは、そのようになるコードですが、F列が"外来"だけのもののはずですが、
すべてですか?"外来"だけですか?

>データベースは、Fの列が入院・外来のセルになっているので「Field:=6」で合っていると思います。このデータベースはユーザーフォームによって入力・削除できるようにしているので、それに原因があるのでしょうか?入院・外来の部分はユーザーフォーム上のオプションボタンで選択して"入院""外来"が入力されるように設定しています。

どのような入力方法かはともかく、「データベース」のF列に「入院・外来」が、
入力されているかどうかですが・・・

【55081】Re:データー抽出とワークシートへの転記
発言  Regina  - 08/4/14(月) 18:32 -

引用なし
パスワード
   ▼ponpon さん:
ありがとうございます。

>>>>Sub TEST()
>>>>  With Worksheets("データベース")
>>>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>>>    With .AutoFilter.Range
>>>>      .Columns(2).Offset(1).Resize(.Rows.Count - 1) _
>>>>      .SpecialCells(xlCellTypeVisible).Copy _
>>>>      Worksheets("抽出外来").Range("A1")
>>>>    End With
>>>>    .AutoFilterMode = False
>>>>  End With
>>>>End Sub
>>>
>>上記のコードを、Criteria1:="外来"をCriteria1:="入院"にしたら、入院のみの氏名のみ抽出できました。
>
>>>>Sub TEST2()
>>>>  Worksheets("抽出外来").Cells.ClearContents
>>>>  With Worksheets("データベース")
>>>>    .AutoFilterMode = False
>>>>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>>>>    With .AutoFilter.Range  ' 此処にブレークポイントでフィルターの
>>>>                 ' 結果を見てください。 
>
>             ここで、「外来」だけが抽出されてますか?

ですが、With .AutoFilter.Rangeの部分で、
「実行時エラー"1004" アプリケーション定義またはオブジェクト定義のエラーです」となりました。

【55086】Re:データー抽出とワークシートへの転記
発言  ponpon  - 08/4/14(月) 23:02 -

引用なし
パスワード
   「入院」ではうまくいき、「外来」ではダメ???
F列に「外来」の入っているセルはありますか?
原因は、わかりません。

私が書くとこんな感じになるのですが・・・

Sub test3()
  With Sheets("データベース")
    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
    .AutoFilter.Range.Columns(2).Offset(1).Copy Sheets("抽出外来").Range("A1")
    .AutoFilterMode = False
  End With
End Sub


Sub test4()
  With Sheets("データベース")
    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
    With .AutoFilter.Range.Columns(2)
      If .SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Offset(1).Copy Sheets("抽出外来").Range("A1")
      End If
    End With
    .AutoFilterMode = False
  End With
End Sub

【55117】Re:データー抽出とワークシートへの転記
お礼  Regina  - 08/4/15(火) 17:23 -

引用なし
パスワード
   ▼ponpon さん:
ありがとうございます。

>Sub test3()
>  With Sheets("データベース")
>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>    .AutoFilter.Range.Columns(2).Offset(1).Copy Sheets("抽出外来").Range("A1")
>    .AutoFilterMode = False
>  End With
>End Sub
>
上記コードでは抽出できませんでした。
>Sub test4()
>  With Sheets("データベース")
>    .Range("A1").AutoFilter Field:=6, Criteria1:="外来"
>    With .AutoFilter.Range.Columns(2)
>      If .SpecialCells(xlCellTypeVisible).Count > 1 Then
>        .Offset(1).Copy Sheets("抽出外来").Range("A1")
>      End If
>    End With
>    .AutoFilterMode = False
>  End With
>End Sub
この上記コードで抽出できました。
入院と外来をそれぞれボタンを付けてクリックにて動作しています。

ひとつのボタンクリックで、入院抽出・外来抽出できればいいなと思っています。

【55118】Re:データー抽出とワークシートへの転記
発言  ponpon  - 08/4/15(火) 21:14 -

引用なし
パスワード
   ▼Regina さん:
私の方では、両方抽出できているので、原因はわかりません。

>ひとつのボタンクリックで、入院抽出・外来抽出できればいいなと思っています。
たとえば、
「抽出入院」「抽出外来」というシートに一度でそれぞれ書き出します。

Option Explicit
Sub test5()
  Dim NYGAI As Variant
  With Sheets("データベース")
    For Each NYGAI In Array("外来", "入院")
      .Range("A1").AutoFilter Field:=6, Criteria1:=NYGAI
      With .AutoFilter.Range.Columns(2)
        If .SpecialCells(xlCellTypeVisible).Count > 1 Then
          .Offset(1).Copy Sheets("抽出" & NYGAI).Range("A1")
        End If
      End With
    Next
    .AutoFilterMode = False
  End With
End Sub

4697 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free