Excel VBA質問箱 IV

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

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


39960 / 76738 ←次へ | 前へ→

【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 質問
【41881】1文字ずつセルに分割する方法? Ned 06/8/24(木) 22:09 発言
【41882】Re:困っています Kein 06/8/24(木) 22:22 回答
【41885】Re:困っています 四苦八苦 06/8/24(木) 22:53 お礼

39960 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free