Access VBA質問箱 IV

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

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


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

1165 / 9994

←次へ　｜　前へ→


	【12128】Re:同じならば更新しない

ちん - 12/2/3(金) 14:27 -


	引用なし

	パスワード

▼ｒｖｒさん、こんにちわ、ちんといいます。
配列を使用し、同じヘッダー情報だったら、前の作業指示NOを使用するで、
どうでしょうか？
サンプルとして、
>'１つ前の会社コード～運転者名が一致していたら、作業指示Noは取得しない
>
>If (Header.会社コード <> ws.Cells(lRowH + CST_ROW_会社コード, _
>　　　　　　　　　　　　　　　　　lColH + CST_COL_会社コード).Value) Or _
>　 (Header.会社名 <> ws.Cells(lRowH + CST_ROW_会社名, _
>　　　　　　　　　　　　　　　 lColH + CST_COL_会社名).Value) Or _
>　 (Header.車番 <> ws.Cells(lRowH + CST_ROW_車番, _
>　　　　　　　　　　　　　　　 lColH + CST_COL_車番).Value) Or _
>　 (Header.運転手コード <> ws.Cells(lRowH + CST_ROW_運転手コード, _
>　　　　　　　　　　　　　　　　　lColH + CST_COL_運転手コード).Value) Or _
>　 (Header.運転手名 <> ws.Cells(lRowH + CST_ROW_運転手名, _
>　　　　　　　　　　　　　　　lColH + CST_COL_運転手名).Value) Then
>　　　　
>　　　　'作業指示No取得
>　　　　l作業指示No = Get作業指示No
>
>　　　　'作業指示No更新
>　　　　Call upd作業指示No(l作業指示No)
>
>　　　　'指示書行No更新
>　　　　i行 = 1
>End If
↑の処理をやめて、以下の処理にしてください。

　'***　テーブル　１６ページ×３シート分のテーブルを用意
　Dim dataExcel_TBL　　　　　　　As Integer
　Dim TBL_運送区分(1 To 48)　　　As Integer
　Dim TBL_会社CD(1 To 48)　　　　As Integer
　Dim TBL_会社名(1 To 48)　　　　As String
　Dim TBL_車番(1 To 48)　　　　　As Integer
　Dim TBL_社員(1 To 48)　　　　　As Integer
　Dim TBL_社員名(1 To 48)　　　　As String
　Dim TBL_日付(1 To 48)　　　　　As Date
　Dim TBL_作業指示NO(1 To 48)　　As Long
　Dim TBL_行(1 To 48)　　　　　　As Long
　Dim i1　　　　　　　 As Integer　　'*** ヘッダーテーブル使用位置番号
　
　'***　同じヘッダーが既に登録済みかをチェックする。
　For i1 = 1 To dataExcel_TBL
　　If (TBL_会社CD(i1) = ws.Cells(lRowH + CST_ROW_会社コード, _
　　　　　　　　　　　　　　 lColH + CST_COL_会社コード).Value) And _
　　(TBL_会社名(i1) = ws.Cells(lRowH + CST_ROW_会社名, _
　　　　　　　　　　　　　　　 lColH + CST_COL_会社名).Value) And _
　　(TBL_車番(i1) = ws.Cells(lRowH + CST_ROW_車番, _
　　　　　　　　　　　　　　　 lColH + CST_COL_車番).Value) And _
　　(TBL_社員(i1) = ws.Cells(lRowH + CST_ROW_運転手コード, _
　　　　　　　　　　　　　　　　　lColH + CST_COL_運転手コード).Value) And _
　　(TBL_社員名(i1) = ws.Cells(lRowH + CST_ROW_運転手名, _
　　　　　　　　　　　　　　　lColH + CST_COL_運転手名).Value) Then
　　'*** 同じヘッダーを発見しました。
　　　Exit For
　　End If
　Next i1
　If i1 > dataExcel_TBL Then
　　'*** 同じヘッダーがない。新規作業指示NO　取得
　　dataExcel_TBL = i1
　　TBL_会社CD(i1) = ws.Cells(lRowH + CST_ROW_会社コード, _
　　　　　　　　　　　　　　 lColH + CST_COL_会社コード).Value
　　TBL_会社名(i1) = ws.Cells(lRowH + CST_ROW_会社名, _
　　　　　　　　　　　　　　　 lColH + CST_COL_会社名).Value
　　TBL_車番(i1) = ws.Cells(lRowH + CST_ROW_車番, _
　　　　　　　　　　　　　　　 lColH + CST_COL_車番).Value
　　TBL_社員(i1) = ws.Cells(lRowH + CST_ROW_運転手コード, _
　　　　　　　　　　　　　　　　　lColH + CST_COL_運転手コード).Value
　　TBL_社員名(i1) = ws.Cells(lRowH + CST_ROW_運転手名, _
　　　　　　　　　　　　　　　lColH + CST_COL_運転手名).Value
　　
　　'作業指示No取得
　　l作業指示No = Get作業指示No

　　'作業指示No更新
　　Call upd作業指示No(l作業指示No)
　　'*** 作業指示NOをテーブルへ保存
　　TBL_作業指示NO(i1) = l作業指示No

　　'指示書行No更新
　　i行 = 1
　　'*** i行をテーブルへ保存
　　TBL_行(i1) = i行
　Else
　　'*** 同じヘッダーがありました。
　　'*** 作業指示NOをテーブルへ保存
　　l作業指示No = TBL_作業指示NO(i1)
　　'指示書行No更新
　　i行 = TBLSET(i1).KEY_行 + 1
　
　End If

※注意として、i行 = i行 + 1　の次の行に、必ず、
　　TBLSET(i1).KEY_行 = i行　を記述してください。

以上、参考までに・・・

431 hits

▼

【12117】同じならば更新しない ｒｖｒ 12/1/31(火) 9:43