[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入荷マスタの更新』（雪だるま）
上記の質問でお世話になった者です。
上記のトピにある「投入表」のレイアウトが変わったので自分でコードをいじって在庫を更新しようとしたのですが どうしても在庫が反映されません。
☆「投入表」レイアウトの変更点 H8セルに数量を記載して全ての商品をH8セルの数量分更新していたのを、各商品ごとに数量を設定するように変更
新「投入表」レイアウト
A B C D ～ 1 業務No：○○ 2 : 7 倉庫 棟 11 作業場 ① ② ③ ～ 12 分類 梱包物 部品 部品 ～ 13 数量 200 3000 1200 ←※変更 14 品名 封筒A お歳暮ビラ カタログA ～ 15 在庫ID AAA01 AAA02 BBB01 ～ 16 入荷日 11/11/1 11/11/20 11/11/10 ～ 17 使用期限 12/3/20 12/1/10 12/2/20 ～ ： ： ： ： ：
それで下記のようにコードを書き換えましたが、投入表の作成はされるものの、同時にO列・P列に 作業用のデータが抽出されるはずなのが何も出て来ないのでマスタデータの更新ができません。
どこが間違っているのでしょうか
Option Explicit
Private Function DrawUp(wksShip As Worksheet) As Boolean
Dim c As Long ←※変更
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim rngList As Range
Dim rngResult As Range
Dim rngWork As Range
Dim vntData As Variant
Dim vntSets As Variant
Dim vntPlace As Variant
Dim lngCount As Long
Dim vntStockID As Variant
Dim vntResult As Variant
Dim lngMax As Long
Dim rngSearch As Range
Dim vntSearch As Variant
Dim strForm As String
Dim blnLack As Boolean
Dim cnt As Long
Dim sagyoGrp() As Variant
Dim strProm As String
'マスターListの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = Worksheets("マスター").Range("A3")
'投入表の在庫IDセル位置を基準とする（行見出しのセル位置）
Set rngResult = ActiveSheet.Range("A15") ←※変更
'作業用シートの抽出範囲の先頭セル位置(マスタから必要データを抽出)
Set rngWork = Worksheets("作業用").Range("A1")
'★「投入表」に書き込む「入荷マスタ」の探索Keyの基準先頭セル位置
Set rngSearch = rngResult.Parent.Range("O1")
'画面更新を停止
Application.ScreenUpdating = False
With rngSearch
'「入荷マスタ」更新データの行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'更新データの消去
If lngRows > 0 Then
If MsgBox("前回の更新が行われていません、このまま実行しますか？", _
vbInformation + vbYesNo + vbDefaultButton2) = vbYes Then
.Offset(1).Resize(lngRows, 2).ClearContents
Else
'※データ更新が行われていない場合、戻り値をTrueに
DrawUp = True
strProm = "マスタのデータ更新を行って下さい"
GoTo Wayout
End If
End If
End With
'投入表に就いて
With rngResult
'列数の取得
lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column
If lngColumns <= 0 Then
strProm = .Parent.Name & "にデータが有りません"
GoTo Wayout
End If
'出庫場所を取得
vntPlace = .Parent.Range("B7:C7").Value
'在庫IDを取得
'★「投入表」の在庫IDが1列の場合に対処
vntStockID = .Offset(, 1).Resize(, lngColumns + 1).Value
ReDim Preserve vntStockID(1 To 1, 1 To lngColumns)
'行数の取得
End With
'マスターから必要データを取得
If Not GetData(vntData, rngList, rngWork, vntStockID, vntSearch) Then
strProm = "データの取得が出来ません、在庫ID、出庫場所等を確認して下さい"
GoTo Wayout
End If
'セル書式を取得
strForm = rngWork.Offset(1).NumberFormat
'データ行数を取得
lngRows = UBound(vntData, 1)
'投入表の在庫IDを横に見て行って
For i = 1 To lngColumns
For c = 2 To lngColumns ←※変更
'Set数を取得
vntSets = Cells(14, c).Value
If Val(vntSets) < 1 Then
strProm = "セット数が設定されていません"
GoTo Wayout
End If
'必要数を転記
lngCount = vntSets
'出力用配列を初期化
ReDim vntResult(1 To 1)
'入荷マスタの在庫IDを上から見て行って
j = 1
'出力行数を初期化
k = 0
Do Until lngCount <= 0
'在庫IDが等しいなら
If vntStockID(1, i) = vntData(j, 2) Then
'出庫場所のチェックがTrueなら
If PlaceCheck(vntPlace, j, vntData) Then
'出力行を更新
k = k + 1
'出力用配列を拡張
ReDim Preserve vntResult(1 To k * 2)
'入荷受付番号を転記
vntResult(k * 2 - 1) = "'" & vntData(j, 1)
'使用期限を転記
vntResult(k * 2) = GetDate(vntData(j, 4), vntData(j, 5), vntData(j, 6))
'★更新用データの転記位置を更新
cnt = cnt + 1
'★更新用データを格納する配列を拡張
ReDim Preserve sagyoGrp(1 To 2, 1 To cnt)
'★更新用データ配列に「入荷ID」を転記
sagyoGrp(1, cnt) = vntSearch(j, 1)
If lngCount - vntData(j, 3) >= 0 Then
'★必要数より在庫が少ないか同じ場合
sagyoGrp(2, cnt) = vntData(j, 3)
Else
'★必要数より在庫が多い場合
sagyoGrp(2, cnt) = lngCount
End If
'必要数から在庫数を減算
lngCount = lngCount - vntData(j, 3)
End If
End If
'入荷マスタを見る行を更新
j = j + 1
If j > lngRows Then
'出力行を更新
k = k + 1
'出力用配列を拡張
ReDim Preserve vntResult(1 To k * 2)
vntResult(k * 2 - 1) = lngCount & "個不足"
Exit Do
End If
Loop
'結果を出力
rngResult.Offset(1, i).Resize(UBound(vntResult)).Value _
= WorksheetFunction.Transpose(vntResult)
'不足の場合の処理
If InStr(1, vntResult(k * 2 - 1), "個不足") Then
rngResult.Offset(k * 2 - 1, i).Font.Color = vbRed
blnLack = True
End If
'出力の最大行数を保存
If lngMax < k Then
lngMax = k
End If
Next c ←※変更
Next i
'入荷日、使用期限を書き込む
ReDim vntResult(1 To 2, 1 To 1)
vntResult(1, 1) = "入荷日"
vntResult(2, 1) = "使用期限"
For i = 0 To lngMax - 1
rngResult.Offset(i * 2 + 1).Resize(2).Value = vntResult
Next i
With rngSearch.Offset(1)
'★1列目のセル書式を抽出された列同じに設定
.Resize(cnt).NumberFormat = strForm
'★O～P列出力(配列の行列を入れ替えて)
.Resize(cnt, 2).Value = WorksheetFunction.Transpose(sagyoGrp)
End With
'在庫不足が生じているなら
If blnLack Then
strProm = "在庫不足が出ていますので更新データ消去されました"
rngSearch.Offset(1).Resize(cnt, 2).ClearContents
Else
strProm = "処理が完了しました"
'※データ更新が行われていない場合、戻り値をTrueに
DrawUp = True
End If
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
Set rngWork = Nothing
Set rngSearch = Nothing
MsgBox strProm, vbInformation
End Function
Private Function PlaceCheck(vntCheck As Variant, _
lngPos As Long, vntData As Variant) As Boolean
Dim i As Long
'倉庫、棟、棚、番号をチェック
For i = 1 To UBound(vntCheck, 2)
If StrComp(vntCheck(1, i), vntData(lngPos, i - 1 + 7), vbTextCompare) <> 0 Then
Exit For
End If
Next i
'全て一致の場合
If i > UBound(vntCheck, 2) Then
'戻り値としてTrueを返す
PlaceCheck = True
End If
End Function
Private Function GetData(vntData As Variant, rngList As Range, _
rngWork As Range, vntStockID As Variant, _
vntSearch As Variant) As Boolean
' 入荷マスターからAdvancedFilterを使ってデータを取得
Dim i As Long
Dim j As Long
Dim vntCrit As Variant
Dim rngCrit As Range
Dim lngRows As Long
Dim vntDate As Variant
'作業用シートの条件範囲の先頭セル位置(マスタから必要データを抽出)
Set rngCrit = rngWork.Parent.Range("N1")
'在庫IDを抽出条件に出力 ★在庫数が0の場合の処理追加
ReDim vntCrit(1 To UBound(vntStockID, 2), 1 To 2)
For i = 1 To UBound(vntStockID, 2)
vntCrit(i, 1) = "=" & """=" & vntStockID(1, i) & """"
vntCrit(i, 2) = "=" & """>0"""
Next i
rngCrit.Offset(1).Resize(UBound(vntStockID, 2), 2).Value = vntCrit
'入荷マスターから必要データを抽出
DoFilter rngList.CurrentRegion, _
rngCrit.Resize(UBound(vntStockID, 2) + 1, 2), _
rngWork.Resize(, 11)
'作業用シートに就いて
With rngWork
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
GoTo Wayout
End If
'★使用期限（年、月、日）を文字列に変更
vntDate = .Offset(1, 4).Resize(lngRows, 3).Value
For i = 1 To lngRows
For j = 1 To 3
If IsNumeric(vntDate(i, j)) Then
vntDate(i, j) = Right("00" & vntDate(i, j), 2)
End If
Next j
Next i
'★セル書式を文字列に変更
.Offset(1, 4).Resize(lngRows, 3).NumberFormat = "@"
'★文字列にした使用期限（年、月、日）をシート出力
.Offset(1, 4).Resize(lngRows, 3).Value = vntDate
'在庫ID順の使用期限（年、月、日）順の入荷日順でListを整列
'A列から整列する列の列Offsetを指定,全て昇順で
DataSort .Offset(1).Resize(lngRows, 11), Array(2, 4, 5, 6, 1), _
Array(xlAscending, xlAscending, xlAscending, _
xlAscending, xlAscending)
'全列データを配列に取得
vntData = .Offset(1, 1).Resize(lngRows + 1, 10).Value
'★配列に「入荷ID」を取得
vntSearch = .Offset(1).Resize(lngRows + 1).Value
End With
GetData = True
Wayout:
Set rngCrit = Nothing
End Function
Private Function GetDate(vntYear As Variant, vntMonth As Variant, _
vntDay As Variant) As Variant
'使用期限（年&月&日）が日付と認められるなら
If IsDate(vntYear & "/" & vntMonth & "/" & vntDay) Then
'シリアル値に変換
GetDate = DateSerial(vntYear, vntMonth, vntDay)
Else
'*を返す
GetDate = "*"
End If
End Function
Private Sub DoFilter(rngScope As Range, _
rngCriteria As Range, _
rngCopyTo As Range, _
Optional blnUnique As Boolean)
' AdvancedFilterを実行
rngScope.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngCopyTo, _
Unique:=blnUnique
End Sub
Private Sub DataSort(rngScope As Range, _
vntKeys As Variant, _
vntOrders As Variant, _
Optional lngOrientation As Long = xlTopToBottom)
Dim i As Long
Dim rngTop As Range
Set rngTop = rngScope.Cells(1, 1)
With rngTop.Parent
.Sort.SortFields.Clear
For i = 0 To UBound(vntKeys, 1)
.Sort.SortFields.Add Key:=rngTop.Offset(, vntKeys(i)) _
, SortOn:=xlSortOnValues, Order:=vntOrders(i) _
, DataOption:=xlSortNormal
Next i
With .Sort
.SetRange rngScope
.Header = xlNo
.MatchCase = False
.Orientation = lngOrientation
.SortMethod = xlStroke
.Apply
End With
End With
Set rngTop = Nothing
End Sub
Public Sub Main()
' 「投入表」作成マクロ
Dim wksObject As Worksheet
'作表する「投入表」シートを設定
Set wksObject = ActiveSheet
'「投入表」を作成してマスタ更新が行われていない場合
If DrawUp(wksObject) Then
'更新マクロを呼び出す
'DataUpDate wksObject
End If
Set wksObject = Nothing
End Sub
Public Sub MasterUpDate()
' マスタ更新マクロ
DataUpDate ActiveSheet
End Sub
Private Sub DataUpDate(wksShip As Worksheet)
'「入荷マスタ」の探索Keyと成る列（基準セルからの列Offset:A列）
Const clngKey As Long = 0
'「入荷マスタ」の更新する列（基準セルからの列Offset:S列）
Const clngItem As Long = 18
Dim i As Long
Dim lngFound As Long
Dim lngRows As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData As Variant
Dim vntValue As Variant
Dim strProm As String
'Listの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = wksShip.Range("O1")
'結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngResult = Worksheets("マスター").Range("A3")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = .Parent.Name & " は更新済みです"
GoTo Wayout
End If
'O～P列データを配列に取得
vntData = .Offset(1).Resize(lngRows, 2).Value
End With
'入荷マスタの更新確認
If MsgBox("入荷マスタの更新を行います、更新を行うと元には戻せません", _
vbInformation + vbOKCancel + vbDefaultButton2) = vbCancel Then
strProm = "マスタ更新を行わずに終了しました"
GoTo Wayout
End If
'画面更新を停止
Application.ScreenUpdating = False
With rngResult
'行数の取得
lngRows = .Offset(Rows.Count - .Row, clngKey).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = .Parent.Name & " にデータ行が有りません"
GoTo Wayout
End If
'念の為、「入荷マスタ」をA列をKeyとして昇順整列
DataSort Intersect(.CurrentRegion, .CurrentRegion.Offset(1)), Array(0), Array(xlAscending)
End With
'O列に就いて最終行まで繰り返し
For i = 1 To UBound(vntData, 1)
'※「入荷マスタ」のA列に「投入表」のO列が有るか探索(A列が数値の場合）
lngFound = RowSearch(CLng(vntData(i, 1)), rngResult.Offset(1, clngKey).Resize(lngRows))
'探索が失敗した場合、lngFoundに0が帰る
If lngFound > 0 Then
'データを更新
vntValue = rngResult.Offset(lngFound, clngItem).Value
rngResult.Offset(lngFound, clngItem).Value = vntValue - vntData(i, 2)
End If
Next i
'更新データを消去
With rngList
.Offset(1).Resize(UBound(vntData, 1), 2).ClearContents
End With
With rngResult
.Parent.Parent.Activate
.Parent.Activate
.Activate
End With
strProm = "マスタ更新処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
Private Function RowSearch(vntKey As Variant, _
rngScope As Range, _
Optional lngOver As Long) As Long
Dim vntFind As Variant
'Matchによる二分探索
vntFind = Application.Match(vntKey, rngScope, 1)
'もし、エラーで無いなら
If Not IsError(vntFind) Then
'もし、Key値と探索位置の値が等しいなら
If vntKey = rngScope(vntFind).Value Then
'戻り値として、行位置を代入
RowSearch = vntFind
End If
'Key値を超える最小値のある行
lngOver = vntFind + 1
Else
lngOver = 1
End If
End Function
最初はVBAは全然ダメな様な話だったですが、頑張ってますね！！ あの時とハンドルネームは同じだけど人が違っている様に見えるほどですが
今回の修正で、雪だるまさんが多分やろうとした方法は間違いでは無いので 善く気が付きましたね
実際の所では、「For c = 2 To lngColumns ←※変更」は不要です、 もし、此処でやるなら、「For i = 1 To lngColumns」のカウンタ変数のiを使い 「vntSets = rngResult.Parent.Cells(13, i+1).Value」とすれば良さそうです ただ、私が直すとすれば、通常、必要データの取得は成るべく一遍に行うので
'投入表に就いて
With rngResult
の所で、配列に取得しますので、コードの方は其の線で変更しています ただ、実際に動かしていないので他に影響が出るか善く確認して下さい
Option Explicit
Private Function DrawUp(wksShip As Worksheet) As Boolean
' Dim c As Long ←※変更
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim rngList As Range
Dim rngResult As Range
Dim rngWork As Range
Dim vntData As Variant
Dim vntSets As Variant
Dim vntPlace As Variant
Dim lngCount As Long
Dim vntStockID As Variant
Dim vntResult As Variant
Dim lngMax As Long
Dim rngSearch As Range
Dim vntSearch As Variant
Dim strForm As String
Dim blnLack As Boolean
Dim cnt As Long
Dim sagyoGrp() As Variant
Dim strProm As String
'マスターListの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = Worksheets("マスター").Range("A3")
'投入表の在庫IDセル位置を基準とする（行見出しのセル位置）
Set rngResult = ActiveSheet.Range("A15") '←※変更
'作業用シートの抽出範囲の先頭セル位置(マスタから必要データを抽出)
Set rngWork = Worksheets("作業用").Range("A1")
'★「投入表」に書き込む「入荷マスタ」の探索Keyの基準先頭セル位置
Set rngSearch = rngResult.Parent.Range("O1")
'画面更新を停止
Application.ScreenUpdating = False
With rngSearch
'「入荷マスタ」更新データの行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'更新データの消去
If lngRows > 0 Then
If MsgBox("前回の更新が行われていません、このまま実行しますか？", _
vbInformation + vbYesNo + vbDefaultButton2) = vbYes Then
.Offset(1).Resize(lngRows, 2).ClearContents
Else
'※データ更新が行われていない場合、戻り値をTrueに
DrawUp = True
strProm = "マスタのデータ更新を行って下さい"
GoTo Wayout
End If
End If
End With
'投入表に就いて
With rngResult
'列数の取得
lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column
If lngColumns <= 0 Then
strProm = .Parent.Name & "にデータが有りません"
GoTo Wayout
End If
'出庫場所を取得
vntPlace = .Parent.Range("B7:C7").Value
'在庫IDを取得
'★「投入表」の在庫IDが1列の場合に対処
vntStockID = .Offset(, 1).Resize(, lngColumns + 1).Value
ReDim Preserve vntStockID(1 To 1, 1 To lngColumns)
'出庫数を取得（13行目のデータ取得）
vntSets = .Offset(-2, 1).Resize(, lngColumns + 1).Value '◎追加 2012/01/23
ReDim Preserve vntSets(1 To 1, 1 To lngColumns) '◎追加 2012/01/23
End With
'マスターから必要データを取得
If Not GetData(vntData, rngList, rngWork, vntStockID, vntSearch) Then
strProm = "データの取得が出来ません、在庫ID、出庫場所等を確認して下さい"
GoTo Wayout
End If
'セル書式を取得
strForm = rngWork.Offset(1).NumberFormat
'データ行数を取得
lngRows = UBound(vntData, 1)
'投入表の在庫IDを横に見て行って
For i = 1 To lngColumns
' For c = 2 To lngColumns ←※変更
' 'Set数を取得
' vntSets = Cells(14, c).Value
' If Val(vntSets) < 1 Then
' strProm = "セット数が設定されていません"
' GoTo Wayout
' End If
'必要数を転記
' lngCount = vntSets
lngCount = vntSets(1, i) '◎変更 2012/01/23
'出庫数の確認
If lngCount = 0 Then '◎追加 2012/01/23
strProm = "出庫数が入力されていません" '◎追加 2012/01/23
GoTo Wayout '◎追加 2012/01/23
End If '◎追加 2012/01/23
'出力用配列を初期化
ReDim vntResult(1 To 1)
'入荷マスタの在庫IDを上から見て行って
j = 1
'出力行数を初期化
k = 0
Do Until lngCount <= 0
'在庫IDが等しいなら
If vntStockID(1, i) = vntData(j, 2) Then
'出庫場所のチェックがTrueなら
If PlaceCheck(vntPlace, j, vntData) Then
'出力行を更新
k = k + 1
'出力用配列を拡張
ReDim Preserve vntResult(1 To k * 2)
'入荷受付番号を転記
vntResult(k * 2 - 1) = "'" & vntData(j, 1)
'使用期限を転記
vntResult(k * 2) = GetDate(vntData(j, 4), vntData(j, 5), vntData(j, 6))
'★更新用データの転記位置を更新
cnt = cnt + 1
'★更新用データを格納する配列を拡張
ReDim Preserve sagyoGrp(1 To 2, 1 To cnt)
'★更新用データ配列に「入荷ID」を転記
sagyoGrp(1, cnt) = vntSearch(j, 1)
If lngCount - vntData(j, 3) >= 0 Then
'★必要数より在庫が少ないか同じ場合
sagyoGrp(2, cnt) = vntData(j, 3)
Else
'★必要数より在庫が多い場合
sagyoGrp(2, cnt) = lngCount
End If
'必要数から在庫数を減算
lngCount = lngCount - vntData(j, 3)
End If
End If
'入荷マスタを見る行を更新
j = j + 1
If j > lngRows Then
'出力行を更新
k = k + 1
'出力用配列を拡張
ReDim Preserve vntResult(1 To k * 2)
vntResult(k * 2 - 1) = lngCount & "個不足"
Exit Do
End If
Loop
'結果を出力
rngResult.Offset(1, i).Resize(UBound(vntResult)).Value _
= WorksheetFunction.Transpose(vntResult)
'不足の場合の処理
If InStr(1, vntResult(k * 2 - 1), "個不足") Then
rngResult.Offset(k * 2 - 1, i).Font.Color = vbRed
blnLack = True
End If
'出力の最大行数を保存
If lngMax < k Then
lngMax = k
End If
' Next c ←※変更
Next i
'入荷日、使用期限を書き込む
ReDim vntResult(1 To 2, 1 To 1)
vntResult(1, 1) = "入荷日"
vntResult(2, 1) = "使用期限"
For i = 0 To lngMax - 1
rngResult.Offset(i * 2 + 1).Resize(2).Value = vntResult
Next i
With rngSearch.Offset(1)
'★1列目のセル書式を抽出された列同じに設定
.Resize(cnt).NumberFormat = strForm
'★O～P列出力(配列の行列を入れ替えて)
.Resize(cnt, 2).Value = WorksheetFunction.Transpose(sagyoGrp)
End With
'在庫不足が生じているなら
If blnLack Then
strProm = "在庫不足が出ていますので更新データ消去されました"
rngSearch.Offset(1).Resize(cnt, 2).ClearContents
Else
strProm = "処理が完了しました"
'※データ更新が行われていない場合、戻り値をTrueに
DrawUp = True
End If
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
Set rngWork = Nothing
Set rngSearch = Nothing
MsgBox strProm, vbInformation
End Function
(Bun)
Bun様ありがとうございます。 Bun様が丁寧にコメントを入れてくださっていたのでとても勉強になります。
書き換えていただいたコードを実行しましたが、やはり作業列（O列・P列）への書き出しが出来ず、マスタ更新をしようとすると 「マスタは更新済みです」というメッセージが出ます。
ただ気がついたのですが、先月までのデータで、元のままのレイアウト＆コードだとちゃんと動いているのですが、 今月になってから元のレイアウト＆コードでも、いつの間にか作業列への書き出しが出来なくなっていました。 入荷マスターのレイアウトを変えたということはありません、 変更点があるとすれば、入荷実績をユーザーフォームで書き込むようにした時に、今までB列&C列&D列の結合で 表示していた「入荷受付番号」の一部が、入荷実績記入後に数値として扱われるようになったことぐらいです。
A列の「入荷ID」は =ROW()-3 で連番が入るようになっています（これは先月もそうでした）
マスターと作業用シートの見出しも見比べましたが変わりはありません。
作業列への書き出しが出来ない理由として考えられることはありますでしょうか。
（雪だるま）
追記です。
変更点と思われるE列の入荷受付番号を元の =B列&C列&D列 にしてみましたがダメでした。 念のために見出しを先月のものからコピーしてもダメです。
ますます原因がわかりません…
（雪だるま）
直接的な原因は、まだ解りませんが？ 幾つかの疑問が有りますので答えて下さい
>ただ気がついたのですが、先月までのデータで、元のままのレイアウト＆コードだとちゃんと動いているのですが、 >今月になってから元のレイアウト＆コードでも、いつの間にか作業列への書き出しが出来なくなっていました。
この時に、「使用期」「限入荷日」は出力されて居ますか（列見出しでは無く）？ 出ているとして、その中で、在庫不足が出ているのでは在りませんか？
また、この「投入表」を作る時に抽出される「作業用」シートで、最初の話では 在庫を見る「入荷マスタ」のフィールドは「入荷実数」を見る事に成って居たと思いますが？ 実際の在庫更新マクロ「Sub DataUpDate」の中では、在庫引き落としのフィールドは、 「在庫数」と成っている様ですね？（やり取りの間で私が勘違いして居るのかも？） もし、フィールドに「入荷実数」と「在庫数」が有るならこの関係も教えて下さい
また、Upされたコードを善く見ると
'在庫不足が生じているなら
If blnLack Then
strProm = "在庫不足が出ていますので更新データ消去されました"
rngSearch.Offset(1).Resize(cnt, 2).ClearContents
Else
strProm = "処理が完了しました"
'※データ更新が行われていない場合、戻り値をTrueに
DrawUp = True
End If
strProm = "処理が完了しました"
Wayout:
と成って居ますが？ 「Wayout:」のすぐ上の「strProm = "処理が完了しました"」は最終コードには無かった筈です （もし有ったなら、私の間違いです） 「'※データ更新が行われていない場合、戻り値をTrueに」の上の行に同じ物が在りますので この、「Wayout:」のすぐ上の「strProm = "処理が完了しました"」は削除して下さい 此れが有る為、在庫不足に成って居ても、「"在庫不足が出ていますので更新データ消去されました"」の Promptを出して終了する筈が、「"処理が完了しました"」のPromptが出て見掛け上正常終了して居るかのように見えます
要様はこの、「入荷実数」と「在庫数」の関係と在庫不足でも「"処理が完了しました"」が出てしまう為に 更新用データが書き込まれないのではないでしょうか？
(Bun)
Bun様ありがとうございます。
おっしゃるとおりでした。
strProm = "処理が完了しました"
これが原因だったようです。
それで、在庫不足が生じた時に作業列への書き出しができないようです。
ただ、以前は一部の商品に在庫不足があってもそれ以外の商品（あるいは在庫がある範囲の数量）がO列・P列に 出力されていましたが、現在は一部でも不足があれば全く書き出しができません。 (以前のデータのコードも確認して余計な strProm = "処理が完了しました" は削除しました） それとも元々一部に在庫不足が生じたら書き出し自体されない仕様だったのでしょうか。 （すみません、もしかして私が余計な変更を加えていたかもしれません）
使用期限・入荷日は正しく出力されています。
（雪だるま）
>それとも元々一部に在庫不足が生じたら書き出し自体されない仕様だったのでしょうか。
元々、どれか1つの部品が欠品（在庫不足）しても、更新データは削除されて マスタ更新が出来ない様な仕様です
>（すみません、もしかして私が余計な変更を加えていたかもしれません）
多分、余計な変更はされて居ないと思います
余談ですが、コード全体を改めて見て見ましたが、途中での変更、追加の仕様が有った為 現在のコードは大分継ぎ接ぎに成っている様な気がします 雪だるまさんの手が空いた時にもう一度コードを見直して整理を考えた方が善いかもしれません
また、以前コードをUpした時には解らなかった、マスタA列の「入荷ID」等は、
>A列の「入荷ID」は =ROW()-3 で連番が入るようになっています（これは先月もそうでした）
と言う事で、常に1番からの歯抜けの無い物でしたら、「Sub DataUpDate」の中で 念の為A列をKeyとしてList全体を整列を行って居ますが此れは無意味ですし 更新データの「入荷ID」をマスタのA列からMatch関数を使って探索して居ますが 此れも探す必要は在りません 何故なら、上記の様に列見出しの下が1番で歯抜けの無い連番なら、 「入荷ID」の値は、「Sub DataUpDate」の中のrngResultの行Offsetその物です 詰まり、
'※「入荷マスタ」のA列に「投入表」のO列が有るか探索(A列が数値の場合）
lngFound = RowSearch(CLng(vntData(i, 1)), rngResult.Offset(1, clngKey).Resize(lngRows))
'探索が失敗した場合、lngFoundに0が帰る
If lngFound > 0 Then
'データを更新
vntValue = rngResult.Offset(lngFound, clngItem).Value
rngResult.Offset(lngFound, clngItem).Value = vntValue - vntData(i, 2)
End If
は
vntValue = rngResult.Offset(CLng(vntData(i, 1)), clngItem).Value
rngResult.Offset(CLng(vntData(i, 1)), clngItem).Value = vntValue - vntData(i, 2)
で済んでしまいます この様な無駄な部分が有ると思いますので、機会が在ったら確認して見て下さい
PS：昨日Upした修正箇所で、Upしてから気が付いた所がありますので再度Upします 昨日の時点では、もし使用数の入力で入力が無かった場合、
'投入表の在庫IDを横に見て行って
For i = 1 To lngColumns
のしたで、データの妥当性チェックを行ってダメならマクロを終了していましたが 善く考えて見ると、処理を行う前（Loopに入る前）にデータの妥当性チェックを行って ダメならマクロを終了する方が善いと思いましたので、出来れば修正したいと思います 以下▲印を変更
'在庫IDを取得
'★「投入表」の在庫IDが1列の場合に対処
vntStockID = .Offset(, 1).Resize(, lngColumns + 1).Value
ReDim Preserve vntStockID(1 To 1, 1 To lngColumns)
'出庫数を取得（13行目のデータ取得）
vntSets = .Offset(-2, 1).Resize(, lngColumns + 1).Value '◎追加 2012/01/23
ReDim Preserve vntSets(1 To 1, 1 To lngColumns) '◎追加 2012/01/23
For i = 1 To lngColumns '▲追加 2012/01/24
If Val(vntSearch(1, i)) <= 0 Then '▲追加 2012/01/24
strProm = "出庫数のデータに文字列か0以下の数値が入っています" '▲追加 2012/01/24
GoTo Wayout '▲追加 2012/01/24
Next i '▲追加 2012/01/24
End If
・
・
・
'投入表の在庫IDを横に見て行って
For i = 1 To lngColumns
lngCount = vntSets(1, i) '◎変更 2012/01/23
' '出庫数の確認 '▲削除 2012/01/24
' If lngCount = 0 Then '▲削除 2012/01/24
' strProm = "出庫数が入力されていません" '▲削除 2012/01/24
' GoTo Wayout '▲削除 2012/01/24
' End If '▲削除 2012/01/24
'出力用配列を初期化
ReDim vntResult(1 To 1)
(Bun)
>元々、どれか1つの部品が欠品（在庫不足）しても、更新データは削除されて >マスタ更新が出来ない様な仕様です
そうでしたか！了解いたしました。
ところで今回追加・削除していただいたコードですが、
For i = 1 To lngColumns '▲追加 2012/01/24
If Val(vntSearch(1, i)) <= 0 Then '▲追加 2012/01/24
strProm = "出庫数のデータに文字列か0以下の数値が入っています" '▲追加 2012/01/24
GoTo Wayout '▲追加 2012/01/24
Next i '▲追加 2012/01/24
End If
この「End If」を「Next i」の上に入れないと「Nextに対するForがありません」と出るので
For i = 1 To lngColumns '▲追加 2012/01/24
If Val(vntSearch(1, i)) <= 0 Then '▲追加 2012/01/24
strProm = "出庫数のデータに文字列か0以下の数値が入っています" '▲追加 2012/01/24
GoTo Wayout '▲追加 2012/01/24
End If
Next i '▲追加 2012/01/24
としました。
すると vntSearch(1, i) の部分で「型が一致しません」のエラーが出ます。 エラーが出た時は i = 1 です。
End If の入れ方がおかしかったでしょうか
（雪だるま）
ごめん！！、私がボケていました 下記の様に成ります、「End If」と「Next i」が入れ違って居ました 其れと変数がvntSearchでは無くてvntSetsでした
'出庫数を取得（13行目のデータ取得）
vntSets = .Offset(-2, 1).Resize(, lngColumns + 1).Value '◎追加 2012/01/23
ReDim Preserve vntSets(1 To 1, 1 To lngColumns) '◎追加 2012/01/23
For i = 1 To lngColumns '▲追加 2012/01/24
If Val(vntSets(1, i)) <= 0 Then '▲追加 2012/01/24
strProm = "出庫数のデータに文字列か0以下の数値が入っています" '▲追加 2012/01/24
GoTo Wayout '▲追加 2012/01/24
End If '▲追加 2012/01/24
Next i '▲追加 2012/01/24
End With
'マスターから必要データを取得
(Bun)
Bun様
ありがとうございます。
投入表作成できました！
私ももっとVBAを使えるように勉強します
（雪だるま）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.