Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4655 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【55383】オートフィルタの結果を他のシートに反映 Regina 08/5/1(木) 18:36

【55403】Re:オートフィルタの結果を他のシートに反映 Jaka 08/5/2(金) 15:20


	【55383】オートフィルタの結果を他のシートに反映

Regina - 08/5/1(木) 18:36 -


	引用なし

	パスワード

患者さんのデータベースを作成しています。「データーベース」のシートから、「実施記録」と名づけたシートにデータをコピーして使用しています。
「データーベース」には患者ＩＤや氏名、疾患名、主治医、担当者名、性別などをデータとして記録しています。「データーベース」のシート内でオートフィルタをかけて、主治医など選択して、○○医師担当、△△医師担当のみの表示など出来ています。「データーベース」のシート内でのオートフィルタをかけた結果を他のシートにも反映させる場合、どのようなコードが必要でしょうか？「データーベース」の内容は、随時追加しており、決まった数のみでありません(データーが100個だけとかでなく、必要なものを随時追加・削除しています)
以下のコードは、「データーベース」から「実施記録」へデーターをコピーするためのものです。「実施記録」はレコードタイプの「データーベース」の内容を帳票形式に一つ一つのレコードタイプのデーターを表示して、ボタンの「前へ」「後ろへ」で、表示を切り変えています。

　Public mCnt As Long
　Public mNum As Long
　Public mRow As Long
　
Public Sub ChkTable()
　'レコード数
　mCnt = Range("データーベース!A1").End(xlDown).Row - 1
　'表示用のレコード番号
　If mNum = 0 Then
　　 mNum = 1
　End If
　'テーブル内の行番号
　If mRow = 0 Then
　　 mRow = 2
　End If
End Sub
Public Sub CopyRecord(r As Long)
'[データーベース]シートから実施記録にデーターをコピー
Range("E$3").Value = Range("データーベース!A" & r).Value
Range("E$4").Value = Range("データーベース!B" & r).Value
Range("L$4").Value = Range("データーベース!C" & r).Value
Range("R$4").Value = Range("データーベース!D" & r).Value
Range("Z$4").Value = Range("データーベース!E" & r).Value
Range("AA$3").Value = Range("データーベース!F" & r).Value
Range("F$5").Value = Range("データーベース!I" & r).Value
Range("H$6").Value = Range("データーベース!G" & r).Value
Range("Y$6").Value = Range("データーベース!H" & r).Value
End Sub
Sub 前へ_Click()
'パブリック変数の初期化
Call ChkTable

'レコード番号を表示
mNum = mNum - 1
If mNum = 0 Then
　　mNum = 1
　　Exit Sub
End If
Range("A2").Value = "'" & mNum & "/" & mCnt

'1つ前のデーターを表示
mRow = mRow - 1
Call CopyRecord(mRow)
End Sub
Sub 後ろへ_Click()
'パブリック変数の初期化
Call ChkTable

'レコード番号を表示
mNum = mNum + 1
If mNum >= mCnt Then
　　mNum = mCnt
　　Exit Sub
End If
Range("A2").Value = "'" & mNum & "/" & mCnt

'次のデーターを表示
mRow = mRow + 1
Call CopyRecord(mRow)
End Sub


	【55403】Re:オートフィルタの結果を他のシートに...

Jaka - 08/5/2(金) 15:20 -


	引用なし

	パスワード

データの詳細が無かったので、コード読んでません。
オートフィルタ使用例１という事で...。

ただコードだけ記載するのもなんなので、Sheet1に例題表を作ってから
オートフィルタした範囲を実行すればある程度の事は理解できるんじゃないかと思います。
（End Subのbが抜けていたので修正とともに少し別な書き方を追加。）

Sub 例題準備()
TB = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
Range("C4").Resize(, UBound(TB) + 1).Value = TB
Range("C5").Value = 1
Range("C5").AutoFill Destination:=Range("C5:C13"), Type:=xlFillSeries
Range("C5:C13").AutoFill Destination:=Range("C5:K13"), Type:=xlFillDefault
Range("C5:L13").Copy
For i = 1 To 3
　　Range("C65536").End(xlUp).Offset(1).PasteSpecial
Next
End Sub

Sub オートフィルタした範囲()
Dim Cel As Range, Ct As Long
With Sheets("Sheet1")
　 'フィルタ解除
　 .AutoFilterMode = False
　 .Range("B4").AutoFilter Field:=1, Criteria1:="9"
　
　 With .AutoFilter.Range
　　　 MsgBox "項目を含むオートフィルタ全範囲" & vbLf & .Address
　　　 With .Resize(.Rows.Count - 1).Offset(1)
　　　　　 MsgBox "データ部範囲" & vbLf & .Address
　　　　　 If Application.Subtotal(3, .Columns(1)) = 0 Then
　　　　　　　MsgBox "抽出データ無し。"
　　　　　　　Exit Sub
　　　　　 End If

　　　　　 With .SpecialCells(xlCellTypeVisible)
　　　　　　　 .Select
　　　　　　　　MsgBox "抽出したデータ部選択"
　　　　　　　　For Each Cel In .Rows
　　　　　　　　　　Cel.Columns(3).Select
　　　　　　　　　　Ct = Ct + 1
　　　　　　　　　　MsgBox "抽出したセルの" & Ct & "行３列目、" & _
　　　　　　　　　　　　　 Cel.Columns(3).Address(0, 0) & "を選択。"
　　　　　　　　Next
　　　　　 End With

　　　　　 With .Columns(1).SpecialCells(xlCellTypeVisible)
　　　　　　　 .Select
　　　　　　　 MsgBox "抽出したセルの１列目を選択。"
　　　　　　　 For Each Cel In .Cells
　　　　　　　　　 Cel.Select
　　　　　　　　　 MsgBox Cel.Address
　　　　　　　 Next
　　　　　 End With

　　　 End With
　 End With
End With
End Sub

ついでにここ読んでおくと良いかも。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=43413;id=excel


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4655 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free