Access VBA質問箱 IV

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

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


1753 / 2272 ツリー ←次へ | 前へ→

【5429】フィールドデータの並べ替え さつき 05/6/20(月) 14:10 質問[未読]
【5431】Re:フィールドデータの並べ替え 小僧 05/6/20(月) 14:42 発言[未読]
【5440】Re:フィールドデータの並べ替え さつき 05/6/21(火) 9:32 お礼[未読]

【5429】フィールドデータの並べ替え
質問  さつき  - 05/6/20(月) 14:10 -

引用なし
パスワード
   <売上リスト>
契約者名   住所      組織名1  担当者1  組織名2   担当者2・・・
A株式会社  愛知県・・・  岐阜支店  佐藤    第二営業   西田・・・・
B株式会社  岐阜県・・・  三重支店  中川    岐阜支店   佐藤・・・・
C株式会社  三重県・・・  第一営業  神田    三重支店   中川・・・・

上のようなリストがあって、ひとつの契約者に対する担当組織が複数(5コ)並んでいます。これを契約者の住所が愛知県ならば、第一営業、第二営業、第三営業が先頭に、岐阜県ならば岐阜支店、三重県ならば三重支店が先頭に来るように並び替えなければなりません。
下記のようにしてみましたが、Select Case sosikimei のaddnewのところでとまってしまいます。どのように直したらよいでしょうか?どなたかお願いいたします。

Public Sub 担当リスト()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset
Dim sql As String

  Application.Echo False     '画面の再描画をオフ
  DoCmd.Hourglass True      '砂時計ポインタを表示

  Set cn = Application.CurrentProject.Connection '接続
  Set rs = New ADODB.Recordset
  Set rs2 = New ADODB.Recordset
  Set rs3 = New ADODB.Recordset
  rs.Open "売上リスト", cn, adOpenKeyset, adLockOptimistic
  rs2.Open "ワークテーブル", cn, adOpenKeyset, adLockOptimistic
  rs3.Open "担当者リスト", cn, adOpenKeyset, adLockOptimistic

  rs.MoveFirst
  
  Do Until rs.EOF
   
    If keiyakusha <> rs.Fields("契約者名").Value Then
      j = 1
      Do Until rs2.EOF
        rs3.AddNew
        rs3.Fields("契約者名") = rs2.Fields("契約者名")
        For k = 1 To 5
          rs.Fields(j + 2) = rs2.Fields(k)
          j = j + 1
        Next k
        rs3.Update
        rs2.MoveNext
      Loop
    End If
    
    If IsNull(rs.Fields("県名").Value) = True Then
        GoTo 次のレコード
    Else
      If rs.Fields("県名").Value = "愛知県" Then
        For I = 1 To 5
        sosikimei = rs.Fields("組織名" & I).Value
        tantosha = rs.Fields("担当者" & I).Value
        Call aichiken
        Next I
       
      ElseIf rs.Fields("県名").Value = "岐阜県" Then
        For I = 1 To 5
        sosikimei = rs.Fields("組織名" & I).Value
        tantosha= rs.Fields("担当者" & I).Value
         
        If sosikimei = "岐阜支店" Then
        ac_sosiki = "岐阜"
        End If
        Next I
       
      ElseIf rs.Fields("県名").Value = "三重県" Then
        For I = 1 To 5
        sosikimei = rs.Fields("組織名" & I).Value
        tantosha = rs.Fields("担当者" & I).Value
        If sosikimei = "三重支店" Then
        ac_sosiki = "三重"
        End If
        Next I
       
      End If
    
    End If
    rs3.AddNew
    rs3!契約者名I = keiyakusha
    rs3!組織名I = ac_sosiki
    rs3!担当者I = tantosha
    rs3.Update

    sosikimei = ""
    ac_sosiki = ""
    tantosha = ""
    keiyakusha = rs.Fields("契約者名").Value
    
次のレコード:
    rs.MoveNext
  Loop
  
  rs.Close: Set rs = Nothing
  rs2.Close: Set rs2 = Nothing
  rs3.Close: Set rs3 = Nothing
  cn.Close: Set cn = Nothing

  Application.Echo True
  DoCmd.Hourglass False

  MsgBox ("処理が終わりました♪")

End Sub

Public Sub aichiken()

  Select Case sosikimei
    Case "第一営業"
      ac_sosiki = "第1"
    Case "第二営業"
      ac_sosiki = "第2"
    Case "第三営業"
      ac_sosiki = "第3"
    Case "岐阜支店"
      rs2.AddNew
      rs2.Fields(0) = keiyakusha
      rs2.Fields(1) = sosikimei
      rs2.Fields(2) = tantosha
      rs2.Update
    Case "三重支店"
      rs2.AddNew
      rs2.Fields(0) = keiyakusha
      rs2.Fields(1) = sosikimei
      rs2.Fields(2) = tantosha
      rs2.Update

  End Select

End Sub

【5431】Re:フィールドデータの並べ替え
発言  小僧  - 05/6/20(月) 14:42 -

引用なし
パスワード
   ▼さつき さん:
こんにちは。

コード全てを解析していませんが気になった事を。

>Public Sub 担当リスト()
>
>End Sub

の間で
>Dim rs2 As ADODB.Recordset

と宣言していますので、この rs2 のオブジェクトは

>Public Sub aichiken()

のモジュールには反映されていないです。


>Public Sub 担当リスト()

の外側に

Public rs2 As ADODB.Recordset

と宣言するか、

Call aichiken(rs2)

Public Sub aichiken(rs2 As ADODB.Recordset)

として、rs2 を値渡しすれば「aichiken」モジュールでも rs2 のオブジェクトが
使えるようになります。

>Select Case sosikimei のaddnewのところでとまってしまいます。

その際に出力されるエラーメッセージを記載して頂くと、より状況が
解りやすくなるかと思われます。

【5440】Re:フィールドデータの並べ替え
お礼  さつき  - 05/6/21(火) 9:32 -

引用なし
パスワード
   小僧 さん、ありがとうございます。見直してみます。

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