Results of 1 - 1 of about 37686 for IF (0.007 sec.)
- [[20120123155217]]
- #score: 1591
- @digest: 963d86ad50a51e3ee6765ed3efd8f67b
- @id: 57393
- @mdate: 2012-01-24T08:20:00Z
- @size: 37678
- @type: text/plain
- #keywords: 加20 (156509), vntsets (117774), vntstockid (115666), 荷マ (110911), lngcolumns (86902), vntsearch (85674), strprom (80644), sagyogrp (77111), vntresult (72671), rngsearch (69438), lngfound (67402), 庫不 (64868), rngresult (60465), lngcount (59612), 庫id (58467), 入表 (58323), vntdata (53477), rngwork (46536), lngrows (42598), 投入 (40204), wayout (38863), 入荷 (34241), 用期 (31610), タ更 (23220), rnglist (20695), 得ln (20396), 新デ (19600), 在庫 (19128), マス (17953), 探索 (16771), 出庫 (12903), 更新 (12295)
- 『入荷マスタの更新』（雪だるま）
[[20111205105217]] 上記の質問でお世話になった者です。 上記のトピにある「投入表」のレイアウトが変わったので自分でコードをいじって在庫を更新しようとしたのですが どうしても在庫が反映されません。 ☆「投入表」レイアウトの変更点 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を使えるように勉強します （雪だるま）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201201/20120123155217.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97045 documents and 608223 words.
訪問者：