スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

クロス集計表示上で入力 前編 


節分ですね~~ ○○はそと~~
久しぶりの記事なので、面白そうなものを・・・・
また、最近似たような質問を見かけましたし・・・
※ 質問ではテーブル構成も違うようだし・・・・また、非連結みたいだし・・・・

ってことで、標題「クロス集計表示上で入力」は、もちろんフォームを使う方法になります。
連結の帳票フォームとして実現するものです。

以下の様なテーブル4つがあるとします。

kEnt147_Table

その中でメインとなるテーブルは「T受付」になります。

何日の、どういう時間帯で、品物が何個・・・・

例えば、以下のデータが入っていたとします。
an受付日受付時間品番数量
12013/01/3110 キュウリ3
22013/01/3112 トマト5
32013/01/3111 ナス7
42013/01/3113 ジャガイモ6
52013/01/3115 キュウリ10
62013/01/3115 トマト23
72013/01/3117 キャベツ1
※ 「品番」部分は「T品名」をルックアップして、品名を表示するようにしています。

で、以下のクロス集計で表示してみると
TRANSFORM First(数量) AS 値
SELECT 受付日, 受付時間
FROM T受付 INNER JOIN T品名 ON T受付.品番=T品名.品番
GROUP BY 受付日, 受付時間
PIVOT 品名;

受付日受付時間キャベツキュウリジャガイモトマトナス
2013/01/3110 3   
2013/01/3111    7
2013/01/3112   5 
2013/01/3113  6  
2013/01/3115 10 23 
2013/01/31171    

となるんですが、

・「T営業」にある受付時間は全部表示したいな・・・・
・表示したところで数量を入力したいな・・・・

入力操作は、取り消しできたり、ここの段階で登録・・・・ってしたいな・・・・・
ということで、以下のフォームを・・・・
(画像はデータを入れる前に採取したので空白のままです)

F1: 受付日を入力することで、帳票形式にて表示&入力
  どうせなら入力する品名部分を表示・非表示してみましょうか・・・・
kEnt147_F1  kEnt147_F1_1  kEnt147_F1_D

F2: 画面は F1 と同じで、チョッと処理を変更したもの(F1 との違いは後述)

kEnt147_F2

F3M / F3S: クロス集計から脱線して、メイン/サブの構成で・・・

kEnt147_F3M
kEnt147_F3M_1 kEnt147_F3M_2 kEnt147_F3M_3 kEnt147_F3M_D

なお、F3M / F3S の説明は 後編にて

※ サンプルファイルは本記事にて

【追記】10/16
クロス集計表示上での入力は「予定表」でもやってます。
そこでは、列を固定(列見出しを指定)しているので、本記事より考えやすかと思います。

 
まず、操作中のデータをどう持つか・・・・これを決定します。
元に戻す・登録・・・・この操作があるので、作業用のテーブル「T作業用」を用いることとします。
作業用テーブルを使う・・・これはこれで良いのですが、使い方にも幾つかあって
1)「T受付」に登録されている対象の日のデータを、作業用テーブルに丸々コピー
   作業用テーブルだけで操作後、本テーブルへ反映する。
2)操作の変更部分だけを作業用テーブルに持って、登録時に本テーブルとマージする。

操作のやり直し・・・・とした場合、
1)では、作業テーブルのクリア&データのコピー
2)では、作業テーブルのクリアだけ

本テーブル「T受付」のデータ量が多くなれば、1)の方法が良さそうだけど・・・・
今回 2)の方法でやってみる。
( 2)の方が難易度ありそうだから・・・・2)が出来れば1)は容易かも・・・・)

では、テーブル「T受付」と「T作業用」をどう結び付けるか・・・・・ですが
当初考えていたのは、「T作業用」にあるものと「T受付」の対象日で「T作業用」にないもの・・・
SELECT 受付時間, 品番, 数量 FROM T作業用
UNION ALL
SELECT 受付時間, 品番, 数量 FROM T受付 WHERE 受付日=#2013/1/31# AND
NOT EXISTS (SELECT 1 FROM T作業用 WHERE 受付時間=T受付.受付時間 AND 品番=T受付.品番);

上記のままであれば、結果は表示されますが、クロス集計に組み込むとエラーになって・・・
NOT EXISTS のところの T受付. がどうたらこうたら・・・・
上記をクエリで作って、そのクエリを元にクロス集計・・・・でも同様にエラーに・・・・
( 2)を選んだ収穫になりましたが)
なので、NOT EXISTS 部分を
DLookup('受付時間','T作業用','受付時間=' & 受付時間 & ' AND 品番=' & 品番) Is Null
に変更しました。
で、結果以下のクロス集計に落ち着きました。
TRANSFORM First(数量) AS 値
SELECT Q1.受付時間 FROM
T営業 AS Q1 LEFT JOIN
(SELECT 受付時間, 品番, 数量 FROM T作業用
UNION ALL
SELECT 受付時間, 品番, 数量 FROM T受付 WHERE 受付日=#2013/1/31# AND
DLookup('受付時間','T作業用','受付時間=' & 受付時間 & ' AND 品番=' & 品番) Is Null) AS Q2
ON Q1.受付時間=Q2.受付時間
GROUP BY Q1.受付時間
PIVOT 品番;

列部分は「品名」である必要はない(フォーム上で置換え表示すれば良い)ので「品番」そのままで・・・
上記の表示は以下の様な感じで
受付時間<>12345
9      
10 3    
11   7  
12  5   
13     6
14      
15 1023   
16      
17    1 

(項目部分の「<>」は、LEFT JOIN したことによる「品番」Null の表示の様です)

さて、今度は「T作業用」から「T受付」へのマージ操作ですが、
・更新・追加・・・この切り換えは面倒なので、1回の Update で・・・
・「T受付」からの削除対象を「T作業用」にどう持たせるか・・・
 削除対象は 数量=0 と入力されたものにしましょう・・・これ規則にしました。

これにより、以下のSQLの連続発行でマージが完了します。

更新・追加
UPDATE T受付 AS Q1 RIGHT JOIN (SELECT #2013/1/31# AS 受付日, * FROM T作業用) AS Q2
ON (Q1.受付日=Q2.受付日) AND (Q1.受付時間=Q2.受付時間) AND (Q1.品番=Q2.品番)
SET Q1.受付日=Q2.受付日, Q1.受付時間=Q2.受付時間, Q1.品番=Q2.品番, Q1.数量=Q2.数量
WHERE Q2.数量>0;
※ 数量は正の数( Q2.数量>0 )としましたが、負も扱いたければ Q2.数量<>0 に・・・

削除
DELETE * FROM T受付 WHERE 受付日=#2013/1/31# AND
EXISTS (SELECT 1 FROM T作業用 WHERE 数量=0 AND 受付時間=T受付.受付時間 AND 品番=T受付.品番);

※ 今まで記述してきたクエリ内の日付 2013/1/31 部分は置換えしやすいように宣言しておきます。
例えば、
DELETE * FROM T受付 WHERE 受付日=#{%1}# AND
EXISTS (SELECT 1 FROM T作業用 WHERE 数量=0 AND 受付時間=T受付.受付時間 AND 品番=T受付.品番);


では、上記をイメージしながらフォーム「F1」を作っていきます。

フォーム「F1」の作成

kEnt147_F1_D  kEnt147_F1  kEnt147_F1_1
フォームをデザインから作っていきます。

・基本的なところをまず変更しておきます。
 ポップアップ「はい」、既定のビュー「帳票フォーム」、レコードセレクタ/移動ボタン「いいえ」

・コントロールを配置していきます
ヘッダ部に
a) 受付日入力用テキストボックス「txtDate」(書式:日付(S))
b) 表示品名選択用チェックボックス「cb1」~「cb5」
c) 帳票用のラベル
 受付時間用「lab0」
 品名用「lab1」~「lab5」
詳細部に
d) 受付時間用テキストボックス「txt0」(使用可能「いいえ」/編集ロック「はい」)
e) 数量表示用テキストボックス「txt1」~「txt5」
f) 数量入力用テキストボックス「txb1」~「txb5」(上記「txt1」~「txt5」に重ねて最背面に)
フッタ部に
g) 元に戻す用コマンドボタン「btn1」
h) 登録用コマンドボタン「btn2」

この配置から、扱える品物の個数は5つまでです。
それ以上扱いたい場合は、
・横にドンドン並べていくか
・タブを使って、1ページ5つ・・・とか表示を工夫していきます。
(その際、上記 1 ~ 5 のところの個数は同じにします)

処理の順としては、以下の様な感じです。

まず、起動されたらフォームの大きさ(縦)を決定します。
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * DCount("*", "T営業") _
          + Me.Section(acFooter).Height

受付日部分は起動時の日付を設定して、必ず日付が入力されているように入力規則を設定
  With Me.txtDate
    .Value = Date
    .ValidationRule = "Is Not Null"
    .ValidationText = "必ず入力してください"
    .AfterUpdate = "=ShowFormInit()"
  End With

ヘッダのチェックボックス部分に、扱っている品名を割り当てていきます。
(扱っている品物が5つなかったら表示しないように)
  rs.Source = "SELECT * FROM T品名 ORDER BY 品番;"
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  For i = 1 To 5
    With Me("cb" & i)
      If (rs.EOF) Then
        .Tag = ""
        .Visible = False
      Else
        .Value = True
        .Tag = rs("品番")
        .OnClick = "=cbToLabel()"
        .Controls(0).Caption = rs("品名")
        rs.MoveNext
      End If
    End With
  Next
  rs.Close

この時、クリックされた時「品番は?」がすぐにわかるように、Tag に設定しておきます。
クリックされたら、表示を切り替えるものなので、ラベル(「品名」を表示している部分)を更新します。
  j = 1
  For i = 1 To 5
    If (Not Me("cb" & i).Visible) Then Exit For
    If (Me("cb" & i)) Then
      With Me("lab" & j)
        .Tag = Me("cb" & i).Tag
        .Caption = Me("cb" & i).Controls(0).Caption
        .Visible = True
      End With
      Me("txt" & j).Visible = True
      Me("txb" & j).Visible = True
      j = j + 1
    End If
  Next
  For i = j To 5
    With Me("lab" & i)
      .Tag = ""
      .Visible = False
    End With
    Me("txt" & i).Visible = False
    Me("txb" & i).Visible = False
  Next
  Call ShowForm(False)

「品名」を表示するラベルでは、
チェックボックス「cb1」~「cb5」の状態を確認し、自分のところは "何の品名?" を割り当てていきます。
この割り当てと同時に Tag に、チェックボックスが持っていた Tag(品番)を設定しておきます。
このラベルの列と、詳細で表示する数量の表示(可視/不可視)は一致するので、
あわせて「txt1」~「txt5」/「txb1」~「txb5」の Visible を設定します。

設定できたところで、詳細にある「txt1」~「txt5」のコントロールソースを変更します。
ラベル部分(数量の表示/非表示)を変更しただけでは、レコードソースには影響ないので、
ラベルに設定した Tag (品番)が Recordset 内にあるか・・・
で、「txt1」~「txt5」のコントロールソースを設定していきます。
  If (Len(Me.RecordSource) = 0) Then Exit Sub
  For i = 1 To 5
    With Me("txt" & i)
    If (Not .Visible) Then Exit For
      For j = 0 To Me.Recordset.Fields.Count - 1
        If (Me.Recordset(j).Name = Me("lab" & i).Tag) Then Exit For
      Next
      If (j >= Me.Recordset.Fields.Count) Then
        .ControlSource = ""
      Else
        .ControlSource = Me.Recordset(j).Name
      End If
    End With
  Next
  Me.txt0.ControlSource = Me.Recordset(0).Name

これにより、クロス集計で求まった中に表示対象の品番がなかったら、その部分は非連結・・・・
連結・非連結での表示は「txt1」~「txt5」が担当します。
入力は同じ位置に最背面として配置した「txb1」~「txb5」が担当します。
最背面に配置した「txb1」~「txb5」のどれかがフォーカスを得ると、
そのレコードのその部分だけが前面に出てくるのを利用するものです。
ここの細工としては、「txt1」~「txt5」がフォーカスを得ようとした際には、
それに対応する「txb1」~「txb5」にフォーカスを移動します。
フォーカスを得た「txb1」~「txb5」では、何を表示していたかを「txt1」~「txt5」から得ます。
その処理の関数設定は、チェックボックスを設定する際に
  For i = 1 To 5
    With Me("txt" & i)
      .OnEnter = "=TextToBack(" & i & ")"
    End With
    With Me("txb" & i)
      .OnEnter = "=TextFromFront(" & i & ")"
      .AfterUpdate = "=TextBackAfterUpdate(" & i & ")"
    End With
  Next
として
実際に行う部分は、
Private Function TextToBack(iNum As Long)
  Me("txb" & iNum).SetFocus
End Function

Private Function TextFromFront(iNum As Long)
  Me("txb" & iNum) = Me("txt" & iNum)
End Function
のように・・・・

では、ここで「txb1」~「txb5」に入力されたら
  rs.Source = "SELECT * FROM T作業用 WHERE 受付時間=" & Me.txt0 & " AND 品番=" & Me("lab" & iNum).Tag & ";"
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  If (IsNull(Me("txb" & iNum))) Then
    If (Not rs.EOF) Then
      rs.Delete
    Else
      rs.AddNew
      rs("受付時間") = Me.txt0
      rs("品番") = Me("lab" & iNum).Tag
      rs("数量") = 0
      rs.Update
    End If
  Else
    If (rs.EOF) Then rs.AddNew
    rs("受付時間") = Me.txt0
    rs("品番") = Me("lab" & iNum).Tag
    rs("数量") = Me("txb" & iNum)
    rs.Update
  End If
  rs.Close
  i = Me.Recordset.AbsolutePosition
  Call ShowForm(True)
  Me.Recordset.AbsolutePosition = i
  Call TextNext(iNum)
のように、「T作業用」テーブルに対して
入力が NULL で、存在していたらそのまま削除を・・・・
存在していなかったら、元々の表示は本テーブル「T受付」のものだったんでしょう・・・・
なら、後で削除するように 数量=0 で登録しておきましょう・・・
入力があったら、そのまま登録しておきましょう・・・・
それらの設定には、今まで順繰りに設定してきた Tag 等使いましょう・・・・

さぁ、入力があったら「txt1」~「txt5」でチャンと表示できるようにクロス集計を求め直しておきましょう。
求め直すことで、列にあたる「品番」が増減(必ずではないけど・・・・)するので、
コントロールソースも割り当てし直しましょう。
入力したら横の数量部分に移動したいな・・・・というのが後半に記述していた部分で、
表示していた行を覚えておいてから、クロス集計を求め直して、また元の行に移動させて・・・・
で、隣のテキストボックスへ・・・・
  If (iNum >= 5) Then
    i = 1
  Else
    i = iNum + 1
    If (Not Me("txt" & i).Visible) Then i = 1
  End If
  If (i = 1) Then
    With Me.Recordset
      .MoveNext
      If (.EOF) Then .MoveFirst
    End With
  End If
  Me("txb" & i).SetFocus

ここで、勉強させられました・・・・
  Me("txb" & i).SetFocus
の部分ですが
  Me("txt" & i).SetFocus
にするとフォーカスを移動できないとか何とかのエラーに・・・・
イメージ的には、txt にフォーカスをあてれば txb に移動すると思うんだけど・・・・

ここでの入力操作ですが、入力して Enter で確定すれば次のテキストボックスに移動します。
ただ、入力して確定せず、違うところをクリックすると、
クリック場所に関係なく、入力した次のにテキストボックスにフォーカスが移動します。
※ クリックしたところではなく、そういうものだという事で・・・・・
※ クリックで移動したい時には、入力後、移動したいところを2回クリックしてください。

上記は「右横」をイメージした記述になっていますが、「下」用に変更するのもチョイですね。

余談的操作)
上記記述(サンプルの現状)でも、縦にドンドン入力していく方法がないわけではありません。
入力したいものだけを表示(1列だけ表示)した状態で入力していきます。

元に戻すボタン「btn1」がクリックされたら、「T作業用」をクリアしてクロス集計の求め直しを・・・
登録ボタン「btn2」がクリックされたら、
更新・追加/削除を行ってから、「T作業用」をクリアしてクロス集計の求め直しを・・・

おまけとして、受付日用「txtDate」がダブルクリックされたら、
以前の記事にもある日付入力支援フォームが起動されます。
そのフォームもちょっと修正してあって・・・・・
日付を戻す際に更新後処理を実行させたかったので txtDate.Text に値を設定するように・・・・

処理の雰囲気は以上です。

フォーム「F1」に記述した VBA は以下
Const SQLBASE1 As String = _
    "TRANSFORM First(数量) AS 値 " _
    & "SELECT Q1.受付時間 FROM " _
    & "T営業 AS Q1 LEFT JOIN " _
    & "(SELECT 受付時間, 品番, 数量 FROM T作業用 " _
    & "UNION ALL " _
    & "SELECT 受付時間, 品番, 数量 FROM T受付 WHERE 受付日=#{%1}# AND " _
    & "DLookup('受付時間','T作業用','受付時間=' & 受付時間 & ' AND 品番=' & 品番) Is Null) AS Q2 " _
    & "ON Q1.受付時間=Q2.受付時間 " _
    & "GROUP BY Q1.受付時間 " _
    & "PIVOT 品番;"

Const SQLBASE2 As String = _
    "TRANSFORM First(数量) AS 値 " _
    & "SELECT Q1.受付時間 FROM " _
    & "T営業 AS Q1 LEFT JOIN " _
    & "(SELECT 受付時間, 品番, 数量 FROM T作業用 " _
    & "UNION ALL " _
    & "SELECT 受付時間, 品番, 数量 FROM T受付 WHERE 受付日=#{%1}# AND " _
    & "initWork() AND myLookup(受付時間, 品番)) AS Q2 " _
    & "ON Q1.受付時間=Q2.受付時間 " _
    & "GROUP BY Q1.受付時間 " _
    & "PIVOT 品番;"

Const SQLBASE3 As String = _
    "UPDATE T受付 AS Q1 RIGHT JOIN " _
    & "(SELECT #{%1}# AS 受付日, * FROM T作業用) AS Q2 " _
    & "ON (Q1.受付日=Q2.受付日) AND (Q1.受付時間=Q2.受付時間) AND (Q1.品番=Q2.品番) " _
    & "SET Q1.受付日=Q2.受付日, Q1.受付時間=Q2.受付時間, Q1.品番=Q2.品番, Q1.数量=Q2.数量 " _
    & "WHERE Q2.数量>0;"

Const SQLBASE4 As String = _
    "DELETE * FROM T受付 WHERE 受付日=#{%1}# AND " _
    & "EXISTS (SELECT 1 FROM T作業用 WHERE 数量=0 AND 受付時間=T受付.受付時間 AND 品番=T受付.品番);"



Private Function TextToBack(iNum As Long)
  Me("txb" & iNum).SetFocus
End Function

Private Function TextFromFront(iNum As Long)
  Me("txb" & iNum) = Me("txt" & iNum)
End Function

Private Sub RecToForm()
  Me.RecordSource = Replace(SQLBASE1, "{%1}", Me.txtDate)
End Sub

Private Sub ShowForm(bVal As Boolean)
  Dim i As Long, j As Long

  If (bVal) Then Call RecToForm
  If (Len(Me.RecordSource) = 0) Then Exit Sub
  For i = 1 To 5
    With Me("txt" & i)
    If (Not .Visible) Then Exit For ' ここのインデント付けミス(本来は1段右)
      For j = 0 To Me.Recordset.Fields.Count - 1
        If (Me.Recordset(j).Name = Me("lab" & i).Tag) Then Exit For
      Next
      If (j >= Me.Recordset.Fields.Count) Then
        .ControlSource = ""
      Else
        .ControlSource = Me.Recordset(j).Name
      End If
    End With
  Next
  Me.txt0.ControlSource = Me.Recordset(0).Name
End Sub

Private Sub TextNext(iNum As Long)
  Dim i As Long

  If (iNum >= 5) Then
    i = 1
  Else
    i = iNum + 1
    If (Not Me("txt" & i).Visible) Then i = 1
  End If
  If (i = 1) Then
    With Me.Recordset
      .MoveNext
      If (.EOF) Then .MoveFirst
    End With
  End If
  Me("txb" & i).SetFocus
End Sub

Private Function TextBackAfterUpdate(iNum As Long)
  Dim rs As New ADODB.Recordset
  Dim i As Long

  Me.Painting = False
  rs.Source = "SELECT * FROM T作業用 WHERE 受付時間=" & Me.txt0 & " AND 品番=" & Me("lab" & iNum).Tag & ";"
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  If (IsNull(Me("txb" & iNum))) Then
    If (Not rs.EOF) Then
      rs.Delete
    Else
      rs.AddNew
      rs("受付時間") = Me.txt0
      rs("品番") = Me("lab" & iNum).Tag
      rs("数量") = 0
      rs.Update
    End If
  Else
    If (rs.EOF) Then rs.AddNew
    rs("受付時間") = Me.txt0
    rs("品番") = Me("lab" & iNum).Tag
    rs("数量") = Me("txb" & iNum)
    rs.Update
  End If
  rs.Close
  i = Me.Recordset.AbsolutePosition
  Call ShowForm(True)
  Me.Recordset.AbsolutePosition = i
  Call TextNext(iNum)
  Me.Painting = True
End Function

Private Function ShowFormInit()
  Me.Painting = False
  CurrentProject.Connection.Execute "DELETE * FROM T作業用;"
  Call ShowForm(True)
  Me.Painting = True
End Function

Private Function cbToLabel()
  Dim i As Long, j As Long

  Me.Painting = False
  j = 1
  For i = 1 To 5
    If (Not Me("cb" & i).Visible) Then Exit For
    If (Me("cb" & i)) Then
      With Me("lab" & j)
        .Tag = Me("cb" & i).Tag
        .Caption = Me("cb" & i).Controls(0).Caption
        .Visible = True
      End With
      Me("txt" & j).Visible = True
      Me("txb" & j).Visible = True
      j = j + 1
    End If
  Next
  For i = j To 5
    With Me("lab" & i)
      .Tag = ""
      .Visible = False
    End With
    Me("txt" & i).Visible = False
    Me("txb" & i).Visible = False
  Next
  Call ShowForm(False)
  Me.Painting = True
End Function

Private Sub CheckBoxSet()
  Dim rs As New ADODB.Recordset
  Dim i As Long

  rs.Source = "SELECT * FROM T品名 ORDER BY 品番;"
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  For i = 1 To 5
    With Me("cb" & i)
      If (rs.EOF) Then
        .Tag = ""
        .Visible = False
      Else
        .Value = True
        .Tag = rs("品番")
        .OnClick = "=cbToLabel()"
        .Controls(0).Caption = rs("品名")
        rs.MoveNext
      End If
    End With

    With Me("txt" & i)
      .OnEnter = "=TextToBack(" & i & ")"
    End With
    With Me("txb" & i)
      .OnEnter = "=TextFromFront(" & i & ")"
      .AfterUpdate = "=TextBackAfterUpdate(" & i & ")"
    End With
  Next
  rs.Close
End Sub

Private Sub Form_Load()

  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * DCount("*", "T営業") _
          + Me.Section(acFooter).Height
  With Me.txtDate
    .Value = Date
    .ValidationRule = "Is Not Null"
    .ValidationText = "必ず入力してください"
    .AfterUpdate = "=ShowFormInit()"
  End With

  Call CheckBoxSet
  Call cbToLabel
  Call ShowFormInit

  Me.txtDate.SetFocus
End Sub


Private Sub txtDate_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F_DATE"
  Cancel = True
End Sub


Private Sub btn1_Click()
  If (DCount("*", "T作業用") = 0) Then Exit Sub
  Call ShowFormInit
  Me.btn1.SetFocus
End Sub

Private Sub btn2_Click()
  If (DCount("*", "T作業用") = 0) Then Exit Sub
  With CurrentProject.Connection
    .Execute Replace(SQLBASE3, "{%1}", Me.txtDate)
    .Execute Replace(SQLBASE4, "{%1}", Me.txtDate)
  End With
  Call ShowFormInit
  Me.btn2.SetFocus
End Sub

 

フォーム「F2」

フォーム「F1」を「F2」としてコピーします。
修正行は1か所
Private Sub RecToForm()
  Me.RecordSource = Replace(SQLBASE1, "{%1}", Me.txtDate)
End Sub
部分を
Private Sub RecToForm()
  Me.RecordSource = Replace(SQLBASE2, "{%1}", Me.txtDate)
End Sub
に変更するだけです・・・・と言ってもユーザ定義関数を標準モジュールに記述しますが。

テーブル「T受付」と「T作業用」をどのように結びつけるか冒頭で記述していました。

DLookup('受付時間','T作業用','受付時間=' & 受付時間 & ' AND 品番=' & 品番) Is Null
に変更しました。

この部分、DLookup を使わずにユーザ定義関数でやってみましょうか・・・・
「T作業用」の内容はそう多くないので、1度メモリに展開しておいて、メモリ上で比較しましょうか・・・
で、標準モジュールに記述したのは以下
Private Const CDELM As String = "_"

Dim dic As Object


Public Function initWork() As Boolean
  Dim rs As New ADODB.Recordset
  Dim sS As String

  If (dic Is Nothing) Then Set dic = CreateObject("Scripting.Dictionary")
  dic.RemoveAll

  rs.Open "T作業用", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  While (Not rs.EOF)
    sS = rs("受付時間") & CDELM & rs("品番")
    dic.Item(sS) = Null
    rs.MoveNext
  Wend
  rs.Close
  initWork = True
End Function

Public Function myLookup(vTime As Variant, vCode As Variant) As Boolean
  Dim sS As String

  myLookup = True
  If (IsNull(vTime) Or IsNull(vCode)) Then Exit Function
  If (dic Is Nothing) Then Call initWork
  sS = vTime & CDELM & vCode
  myLookup = Not dic.Exists(sS)
End Function

 
受付時間と品番とで1つの文字列を作っておいて、それがあるかどうか・・・・
で、クエリの方の記述は・・・・というと、
DLookup('受付時間','T作業用','受付時間=' & 受付時間 & ' AND 品番=' & 品番) Is Null

initWork() AND myLookup(受付時間, 品番)
に・・・・


テーブル「T営業」の受付時間を増やしたり・・・・
いろいろと変更してみてください。

※ サンプルの「T受付」には、データは入ってません。


まあ・・・それなりに動くと思います・・・・・たぶん・・・


クロス集計でのお話はこれ位にして、
・「品番」数が5を越して・・・・とか
・「品番」全部じゃなく、必要なものだけ表示できて入力できればいいや・・・

等々であれば、メイン/サブの構成の方が楽は楽でしょ・・・・???

という事で、フォーム「F3M / F3S」の構成に・・・・この内容は 後編にて・・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt147_2000.zipkEnt147_2003.zipkEnt147_2007.zip
 サイズ 76,59086,65790,735
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/02/03

Category: サンプルかな

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。