ここから本文です

再投稿です エクセル2013 マクロを修正、または新規作成してください。 現...

nor********さん

2017/4/1611:24:07

再投稿です
エクセル2013
マクロを修正、または新規作成してください。

現在、下記のマクロを 「登録」シートに挿入しています。

「一覧」シートに同一内容のデータがあった時、
B列に既に入力がある場合は
次点の同一内容のB列に入力されるようにしたいです。

例えば下記データが3行あった場合
「一覧」シートのC列=ABC D列=100 E列=123456

「登録」シートのA1=ABC A2=100 A3=123456と入力
A4=1 と入力、Enterを押下すると、もちろん「一覧」シートのB列には 1 と反映されます。
続けて、今度はA4=2 とした時に、先程の 「一覧」シートのB列の 1 は残して
次点の同一内容のB列に 2 としたいです。

稚拙な文章で申し訳ありませんが、どうぞ宜しくお願い致します。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WS1 As Worksheet, WS2 As Worksheet
Dim strKey As String, s As String
Dim c As Range, bln As Boolean

Set WS1 = Worksheets("一覧"): Set WS2 = Worksheets("登録")
strKey = Join(Application.Transpose(WS2.Range("A1").Resize(3).Value), "")

For Each c In WS1.Range("B2", WS1.Range("C" & WS1.Rows.Count).End(xlUp))

s = c.Value & c.Offset(0, 1).Value & c.Offset(0, 2).Value
If s = strKey Then
c.Offset(0, 6).Value = Date
c.Offset(0, -1).Value = Worksheets("登録").Range("A4")

c.Resize(1, 10).Interior.ColorIndex = 6
bln = True
Exit For
End If

Next c

If Not bln Then
MsgBox "一覧リストに存在しません", vbExclamation, "NotFound"
End If

End Sub

補足言葉足らずで申し訳ありません。
連番を振りたいわけではありません。
よって、画像の「一覧」シートの中に全く違う値が入っていると仮定してください。
例えば2行目にXYZ 200 987654 ・・・等
「登録」シートのA1~A3の値を「一覧」シートのC~Eを参照して合致したら
「登録」シートのA4の値を「一覧」シートのB列に反映させ、且つI列に日付を入れたいです。
但し、「一覧」シートのC~Eに同一内容の値が入っていた場合は
上から順番に「登録」シートのA4に入力した値が反映されるようにしたいです。
因みに「登録」シートのA4からA5にセルがアクティブになると
A1~A4の値は削除されるようにしています。 Range("A1:A4").Clear
また、「一覧」シートのデータは日々、増減があります。

c.Offset,bln As Boolean,If Not bln Then,Dim c As Range,strKey Then,A4&quot,End If

閲覧数:
147
回答数:
2
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

ask********さん

2017/4/1723:30:37

SelectionChangeではなく、Changeイベントを使用しています。
登録シートの値変更後、a1:a4に空白が無い場合に処理をします。
都合に合わせて修正してください。

文字列変数 s 及び strKey は、各セルの値を"@"で連結させました。
(連結文字を挟まないと、下記のようなケースが同一値になるため)
[ABC][100][123456]
[ABC][1001][23456]

----------------

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim strKey As String, s As String
Dim c As Range, bln As Boolean

If WorksheetFunction.CountBlank(Range("a1:a4")) <> 0 Then
Exit Sub
Else

strKey = Join(Application.Transpose(Range("A1").Resize(3).Value), "@")
Set ws = Sheets("一覧")

For Each c In ws.Range("c2", ws.Range("c" & Rows.Count).End(xlUp))
s = c.Value & "@" & c.Offset(, 1).Value & "@" & c.Offset(, 2).Value

If s = strKey And c.Offset(, -1) = "" Then
c.Offset(, -1) = Val(Range("A4").Value)
c.Offset(, 6).Value = Date
c.Resize(, 10).Interior.ColorIndex = 6

bln = True
Exit For
End If
Next
End If

If Not bln Then
MsgBox "一覧リストに存在しません", vbExclamation, "NotFound"
End If

End Sub

質問した人からのコメント

2017/4/18 21:47:39

素晴らしいです。
思い通りの結果が得られました。
わざわざ再回答までしていただき、本当にありがとうございます。
連結文字の件も勉強になりました。

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

aka********さん

2017/4/1614:11:59

マクロでなく
B列に 最初から =COUNTIFS(C$2:C2,C2,D:D,D2,E:E,E2) と いれておけば
該当の組み合わせで 連番を 振ってくれるのでは

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる