Excel VBA質問箱 IV

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

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


26685 / 76738 ←次へ | 前へ→

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

引用なし
パスワード
   患者さんのデータベースを作成しています。「データーベース」のシートから、「実施記録」と名づけたシートにデータをコピーして使用しています。
「データーベース」には患者IDや氏名、疾患名、主治医、担当者名、性別などをデータとして記録しています。「データーベース」のシート内でオートフィルタをかけて、主治医など選択して、○○医師担当、△△医師担当のみの表示など出来ています。「データーベース」のシート内でのオートフィルタをかけた結果を他のシートにも反映させる場合、どのようなコードが必要でしょうか?「データーベース」の内容は、随時追加しており、決まった数のみでありません(データーが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

2 hits

【55383】オートフィルタの結果を他のシートに反映 Regina 08/5/1(木) 18:36 質問
【55403】Re:オートフィルタの結果を他のシートに反映 Jaka 08/5/2(金) 15:20 発言

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