マクロに詳しい方

質問

Ａ列に１から２００までの数値がランダムかつ歯抜け有りで並んでるとします。
これをＢ”Ａ列に記した数値”のセルに移動することはできますか？
Ａ列に３５とあればＢ３５のセルに移動またはＢ３５のセルに何か文字列を打ち込む感じです。
Ａ列が空欄の時は未処理にできればなおよいです。。。
よろしくお願いします。

回答No.5

hana-hana3 · ベストアンサー

＞各命令文を教えて頂けないでしょうか？

ＶＢＥで、ステートメントにカーソルを置いて、[Ｆ１]でヘルプが表示されます。
ネットで検索しても沢山見つかります。

＞If IsNumeric(Cells(i, 1)) And Cells(i, 1) > 0 Then
条件は「値が数値」であり(AND)「０よりも大きい」時に成立します。
値が０やマイナス、文字の場合だとエラーになるので、無用なエラーを防ぐために値をチェックします。

＞Range("A" & i)
'&' は、文字列を結合します。
"A" という文字と i の値を結合し、"A1" のようになります。

St = "A1:C10,F1:F10"
Range(St).Clear
と記入しても応用できます。

＞Cells(i, 1)

Cells は、セルの列と行を１から始まる数値で指定します。

＞ボタンを押すたびにＢ列、Ｃ列、Ｄ列・・・

似たような動作をするように改造しました。
どのような場合に正しく動作するかは、プログラムを読んで実験して見てください。

Sub warp03() ' Cells()
Dim i As Integer
Dim x As Integer
x = ActiveSheet.UsedRange.Columns.Count + 1
For i = 1 To 200
If IsNumeric(Cells(i, 1)) And Cells(i, 1) > 0 Then
Cells(Cells(i, 1), x) = Cells(i, 1)
End If
Next
End Sub

Sub warp04() ' Range()
Dim i As Integer
Dim x As Integer
x = ActiveSheet.UsedRange.Columns.Count
For i = 1 To 200
If IsNumeric(Range("A" & i)) And Range("A" & i) > 0 Then
Range("A" & Range("A" & i)).Offset(0, x) = Range("A" & i)
End If
Next
End Sub

＞Ａ列を新たに打ち込むたびに

ＶＢＡで「改変されたかどうか」を調べるのはちょっと面倒です。
ボタンを押して、その都度実行しましょう。

お礼

ありがとうございました。
マクロをマスターできるとなんでもできますね。

回答No.4

Wendy02

まあ、こんな風にも出来ますね。

Sub test1()
　Dim nums As Variant
　nums = Range("A1", Range("A65536").End(xlUp)).Value
　'Range("A1", Range("A65536").End(xlUp)).ClearContents
　'移動なら、「'」を外す
　For Each n In nums
　　If n > 0 And IsNumeric(n) Then
　　　Cells(n, 2).Value = n
　　　'文字を入れるのでしたら、上記「=n 」の代わりに、「= "ok"」などとする
　　End If
　Next n
End Sub

補足

ありがとうございます。文字列を入れれました。
ボタンにこのマクロを設定し、ボタンを押すたびにＢ列、Ｃ列、Ｄ列・・・とＡ列を新たに打ち込むたびに列を変えていけますか？？

回答No.3

ja7awu

こんな感じで如何でしょうか。

移動ですよね。

Sub Test()
Dim Rng As Range
For Each Rng In Range("A1", Range("A65536").End(xlUp))
　　If IsNumeric(Rng.Value) And Rng.Value <> "" Then
　　　　If Rng.Value >= 1 And Rng.Value <= 65536 Then
　　　　　　Range("B" & Int(Rng.Value)).Value = Rng.Value
　　　　　　Rng.ClearContents ' 　　<--- コピーするのであれば不要
　　　　End If
　　End If
Next Rng
End Sub

補足

ありがとうございます。
狙ったとおりの機能になっています。
多少のアレンジを加えるために、マクロ初心者にもわかるように各命令文を教えて頂けないでしょうか？
移動もできてしまうなら文字列を打ち込むこともできますか？

回答No.2

hana-hana3

２つの方法が有ります。

Sub warp01() ' Cells()
Dim i As Integer
For i = 1 To 200
If IsNumeric(Cells(i, 1)) And Cells(i, 1) > 0 Then
Cells(Cells(i, 1), 2) = Cells(i, 1)
End If
Next
End Sub

Sub warp02() ' Range()
Dim i As Integer
For i = 1 To 200
If IsNumeric(Range("A" & i)) And Range("A" & i) > 0 Then
Range("B" & Range("A" & i)) = Range("A" & i)
End If
Next
End Sub

補足

ありがとうございます。
どちらの方法でも狙ったとおりの機能になっています。
多少のアレンジを加えるために、マクロ初心者にもわかるように各命令文を教えて頂けないでしょうか？

回答No.1

moon00

こんな感じでしょうか。
移動ではなくコピーという形にしていますが。

Sub セル記入()
Dim i As Integer
Dim j As Integer
Dim k As Integer

i = 1
j = 1
For i = 1 To 200

k = Cells(i, j).Value
Debug.Print k
If k > 0 Then
Cells(k, j + 1).Value = k
End If
Next

End Sub

補足

ありがとうございます。
狙ったとおりの機能になっています。
多少のアレンジを加えるために、マクロ初心者にもわかるように各命令文を教えて頂けないでしょうか？