| |
お世話になります。
アクセスからエクセルをｱｸｾｽﾃｰﾌﾞﾙに取り込む処理を行っております。
エクセルのレイアウトは
運送区分 会社ｺｰﾄﾞ 会社名 車番 社員ｺｰﾄﾞ 社員名 日付 ←ﾍｯﾀﾞｰ
1 0 ○○会社 33 5 △△ 1/31 ←ﾍｯﾀﾞｰ項目
荷主 発地 行先 品名 単位 予定数 ←明細
■ ☆ ◎ ▼ ｷﾛ 30 ←明細項目
◆ ● ○ ▲ ｷﾛ 30
以下続く。。。
このようなｴｸｾﾙﾌｧｲﾙで１ｼｰﾄに最大16ﾍﾟｰｼﾞ分あります。
そして同じような項目でｼｰﾄが３つあります。
この３つのｼｰﾄをｱｸｾｽのﾌｫｰﾑ状にてボタンを押してテーブルに取り込む作業をしています。（３つとも一括で一回のボタン処理で取り込んでいます）
取り込むと１ﾍﾟｰｼﾞにつき１つ作業指示Noがつくようになっております。
これを例えばｼｰﾄ１の１ﾍﾟｰｼﾞ目のﾍｯﾀﾞｰ部分とｼｰﾄ２の２ﾍﾟｰｼﾞ目のﾍｯﾀﾞｰ部分が同じならば作業指示Noはｼｰﾄ１の１ﾍﾟｰｼﾞ目の作業指示Noにしたいのです。
取込み処理もﾛｼﾞｯｸは（だいぶ長いですがすいません）
'**************************************************
'* データ取込処理
'**************************************************
Private Function ImportData() As Boolean
Dim wb As Workbook 'Microsoft Excelブック。
Dim ws As Worksheet '対象セル範囲を含むワークシートを返します。
Dim vSheet As Variant
Dim sht As Variant
Dim dbs As Database
Dim rstT As Recordset
Dim lRowH As Long, lColH As Long 'ヘッダー行、列
Dim lRowM As Long, lColM As Long '明細行、列
Dim iCntH As Integer, iCntM As Integer 'ヘッダー数、明細数
Dim Header As typHaeder 'ヘッダー項目
Dim Meisai As typMeisai '明細項目
Dim l作業指示No As Long '4/2追加
Dim i行 As Long '指示書行No
Dim 運送区分 As Integer
Dim 傭車先コード As Long
Dim 傭車先名 As String
Dim プレートNo As Variant
Dim 傭車先発地コード As Long
Dim 傭車先発地名 As String
Dim 傭車先着地コード As Long
Dim 傭車先着地名 As String
Dim 傭車合計 As Currency
Dim 傭車非課税合計 As Currency
Dim 運賃合計 As Currency
Dim 非課税合計 As Currency
Dim 数量合計 As Integer
Dim 得意先コード As Long
Dim 発着地コード1 As Integer
Dim 発地コード As Long
Dim 発地名 As String
Dim 発着地コード2 As Integer
Dim 着地コード As Long
Dim 着地名 As String
Dim 品目コード As Long
Dim 品コード As Long
Dim 品名 As String
Dim 数量 As Integer
Dim 単位コード As Long
Dim 単位 As String
Dim rstM As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim wInt As Integer '車両コード
Dim 端数 As Integer
Dim 実数 As Integer
Dim 単価 As Currency
Dim 金額 As Currency
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim cl As Range
ImportData = False
'ファイルオープン
Set wb = xlApp.Workbooks.Open(ファイル名.Value)
'データベース接続
Set dbs = CurrentDb
Set rstT = dbs.OpenRecordset("T_作業指示", dbOpenDynaset)
'シート名をセット
vSheet = Array("ｼｰﾄ１", "ｼｰﾄ2", "ｼｰﾄ3")
'シート名分ループ
For Each sht In vSheet
'此処でシートセット
Set ws = wb.Worksheets(sht)
'変数初期化
lRowH = 2: lColH = 1 'ヘッダー行、列
lRowM = 4: lColM = 1 '明細行、列
iCntH = 0: iCntM = 0 'ヘッダー数、明細数
i行 = 1
'ヘッダー読込
Do Until iCntH >= CST_MAX_H_CNT
'１つ前の会社コード〜運転者名が一致していたら、作業指示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
'ヘッダー項目取得
Header.運送区分 = ws.Cells(lRowH + CST_ROW_運送区分, lColH + CST_COL_運送区分).Value
Header.会社コード = ws.Cells(lRowH + CST_ROW_会社コード, lColH + CST_COL_会社コード).Value
Header.会社名 = ws.Cells(lRowH + CST_ROW_会社名, lColH + CST_COL_会社名).Value
Header.車番 = ws.Cells(lRowH + CST_ROW_車番, lColH + CST_COL_車番).Value
Header.運転手コード = ws.Cells(lRowH + CST_ROW_運転手コード, lColH + CST_COL_運転手コード).Value
If Nz(rstT.Fields("運転者コード").Value, 0) = "" Then
rstT.Fields("運転者コード").Value = Null
End If
Header.運転手名 = ws.Cells(lRowH + CST_ROW_運転手名, lColH + CST_COL_運転手名).Value
Header.日付 = ws.Cells(lRowH + CST_ROW_日付, lColH + CST_COL_日付).Value
'運送区分が入力されていなかったら、処理終了
If Trim(Header.運送区分) = "" Then
Exit Do
End If
'明細読込
iCntM = 0 '明細数=0
Do Until iCntM >= CST_MAX_M_CNT 'CST_MAX_M_CNT=31 or 61 明細最大数31以上or61未満になるまで処理
'明細項目取得
Meisai.荷主名 = ws.Cells(lRowM + CST_ROW_荷主名, lColM + CST_COL_荷主名).Value
Meisai.発地名 = ws.Cells(lRowM + CST_ROW_発地名, lColM + CST_COL_発地名).Value
Meisai.行先名 = ws.Cells(lRowM + CST_ROW_行先名, lColM + CST_COL_行先名).Value
Meisai.品名 = ws.Cells(lRowM + CST_ROW_品名, lColM + CST_COL_品名).Value
Meisai.単位 = ws.Cells(lRowM + CST_ROW_単位, lColM + CST_COL_単位).Value
Meisai.予定数 = ws.Cells(lRowM + CST_ROW_予定数, lColM + CST_COL_予定数).Value
Meisai.端数 = ws.Cells(lRowM + CST_ROW_端数, lColM + CST_COL_端数).Value
Meisai.実数 = ws.Cells(lRowM + CST_ROW_実数, lColM + CST_COL_実数).Value
Meisai.単価 = ws.Cells(lRowM + CST_ROW_単価, lColM + CST_COL_単価).Value
Meisai.金額 = ws.Cells(lRowM + CST_ROW_金額, lColM + CST_COL_金額).Value
rstT.AddNew
rstT.Fields("作業指示No").Value = l作業指示No 'ヘッダー、明細にない部分を使用
rstT.Fields("指示書行No").Value = i行
rstT.Fields("伝票日付").Value = Header.日付
rstT.Fields("運送区分").Value = Header.運送区分
rstT.Fields("運賃合計").Value = 運賃合計
rstT.Fields("非課税合計").Value = 非課税合計
rstT.Fields("数量合計").Value = 数量合計
rstT.Fields("得意先コード").Value = Meisai.荷主コード
rstT.Fields("発着地コード1").Value = 発着地コード1
rstT.Fields("発地コード").Value = Meisai.発地コード
rstT.Fields("発地名").Value = Meisai.発地名
rstT.Fields("発着地コード2").Value = 発着地コード2
rstT.Fields("着地コード").Value = Meisai.行先コード
rstT.Fields("着地名").Value = Meisai.行先名
rstT.Fields("品目コード").Value = 品目コード
rstT.Fields("品コード").Value = Meisai.品コード
rstT.Fields("品名").Value = Meisai.品名
rstT.Fields("数量").Value = Meisai.予定数
rstT.Fields("単位").Value = Meisai.単位
rstT.Fields("金額").Value = 金額
rstT.Fields("概算区分").Value = 0
rstT.Fields("備考").Value = Null
rstT.Fields("請求更新ＦＬＧ").Value = False
rstT.Fields("月次更新ＦＬＧ").Value = False
rstT.Fields("傭車更新ＦＬＧ").Value = False
rstT.Fields("入力日").Value = Date
rstT.Update
i行 = i行 + 1 '指示書行=指示書行+1
End If
iCntM = iCntM + 1 '明細数=明細数+1
lRowM = lRowM + 1 '明細行=明細行+1
Loop
iCntH = iCntH + 1 'ヘッダー数=ヘッダー数+1
'次の段へ
If iCntH Mod 2 = 1 Then
lRowH = lRowH + 35 'ヘッダー行=ヘッダー行+35
lRowM = lRowM + 4
Else
lColH = lColH + 15 'ヘッダー列=ヘッダー行+6
lColM = lColM + 15 '明細数=明細列+1
lRowM = 4 '明細行=2
lRowH = 2 'ヘッダー行=2
iCntM = 0 '明細数=0
End If
Loop
Next
説明がへたくそで申し訳ありませんが、よろしくお願い致します。
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
