Excel VBA質問箱 IV

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

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


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

39954 / 76732

←次へ　｜　前へ→


	【41882】Re:困っています

Kein - 06/8/24(木) 22:22 -


	引用なし

	パスワード

ボタンは不要です。Sheet1 のシートモジュールに、以下のイベントマクロを
入れて下さい。
E2:E31 の範囲で単一のセルに数値を入力したとき、その行のデータを
チェック & 取得して自動的に Sheet2 の適切なセル位置へ転記します。
Sheet2 は IV列を作業列とします。ここへ入力された品番と照らし合わせ、
転記しようとしている品番が見つからないときは、IV列の最終入力行の
一つ下の行の A:L列へ転記します。逆に品番が見つかったときは、その行の
K列の数量のみを更新して終わります。

Private Sub Worksheet_Change(ByVal Target As Range)
　 Dim Num As Long, Amot As Long
　 Dim Gods As String, CkV As String
　 Dim CkR As Variant
　 Const PsLine As String = _
　 "[x][x][x][x][x][x][x][x][x]"

　 If Intersect(Target, Range("E2:E31")) _
　　Is Nothing Then Exit Sub
　 With Target
　　　If .Count > 1 Then Exit Sub
　　　If IsEmpty(.Value) Then Exit Sub
　　　If Not IsNumeric(.Value) Then Exit Sub
　　　If WorksheetFunction _
　　　.CountA(.Offset(, -4).Resize(, 5)) < 5 Then Exit Sub
　　　Num = .Offset(, -4).Value
　　　Gods = .Offset(, -3).Value
　　　CkV = .Offset(, -2).Value
　　　Amot = .Value
　 End With
　 With Worksheets("Sheet2")
　　　CkR = Application.Match(CkV, .Range("IV:IV"), 0)
　　　If IsError(CkR) Then
　　　　 With .Range("IV65536").End(xlUp)
　　　　　　.Offset(1).Value = CkV
　　　　　　.Offset(1, -255).Value = Num
　　　　　　.Offset(1).Parse PsLine, .Offset(1, -254)
　　　　　　.Offset(1, -245).Value = Amot
　　　　　　.Offset(1, -244).Value = Gods
　　　　 End With
　　　Else
　　　　 .Cells(CkR, 11).Value = Amot
　　　End If
　 End With
End Sub

0 hits

▼

【41878】困っています 四苦八苦 06/8/24(木) 21:13