EXCEL VBA教示お願い致します

質問

あらかじめＡ１セルに●を設定してあり
K2からT2に1～10の符号をいれておきます

Ａ3からＪ3の10個のセルに1から10の数字を入力した時
同じ数字は入れない
例えばＡ３に5、B３に7、C３に9と入力した時に
K3からT3の5，7，9の位置セルにA1の●を代入する

こんなことができるVBAを利用したいのです
丸投げで申し訳ありませんがよろしくお願いいたします。

回答No.4

kkkkkm · ベストアンサー

> とsheetの最後の列(Aの最後、例えばA5000)まで入力と代入を続けられるように
> するにはどのようにすればよいか　です。

以下で試してみてください。

Sub Test()
Dim c As Range
Dim LastRow As Long, i As Long

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range(.Cells(3, "K"), .Cells(LastRow, "T")).ClearContents
For i = 3 To LastRow
For Each c In .Range(.Cells(i, "A"), .Cells(i, "J"))
If c.Value <> "" And IsNumeric(c.Value) = True Then
.Cells(i, "K").Offset(0, c.Value - 1).Value = .Range("A1").Value
End If
Next
Next
End With
End Sub

お礼

勝手なお願いでありがとうございました。

回答No.3

kkkkkm

> これをsheet1の最後まで続けるには

最後とは？

補足

すいません面倒をおかけします。
A3、B3、C3と3列目に数字を入力
次に
A4、B4、C4　---------
その後に
A5、B5、C5　---------
とsheetの最後の列(Aの最後、例えばA5000)まで入力と代入を続けられるようにするにはどのようにすればよいか　です。

回答No.2

kkkkkm

> K2からT2に1～10

これが左から1～10の順番ではなくランダムに入っているとしたら、こちらで試してみてください。

Sub Test2()
Dim c As Range, FRng As Range

Range("K3:T3").ClearContents
For Each c In Range("A3:J3")
If c.Value <> "" And IsNumeric(c.Value) = True Then
Set FRng = Range("K2:T2").Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not FRng Is Nothing Then
Cells(3, FRng.Column).Value = Range("A1").Value
End If
End If
Next
End Sub

回答No.1

kkkkkm

以下で試してみてください。

Sub Test()
Dim c As Range
Range("K3:T3").ClearContents
For Each c In Range("A3:J3")
If c.Value <> "" And IsNumeric(c.Value) = True Then
Range("K3").Offset(0, c.Value - 1).Value = Range("A1").Value
End If
Next
End Sub

補足

Excellentです
重ねて大変あつかましいのですが
これをsheet1の最後まで続けるには
どこをどのように修正すればよい
のでしょうかご教示よろしくお願いいたします。