![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
VBAを使用しEXCELのセルの値を移動させたいのですが、たとえば下記のように●と▲で構成された同じワークシート内のセルの集合に対し(1)の集合を(2)の集合を維持したまま(2)に移動させたいのです。
(1) (2)
ABCDEFGHI JKLMNOPQR
1▲● ●
2● ▲●
3▲ ● ▲▲●
4●●●● ●●
5▲▲▲●● ●▲
6▲● ●●▲
移動後
(2)((1)+(2))
JKLMNOPQR
1●▲●
2▲●●
3▲▲●▲●
4●●●●●●
5●▲▲▲▲●●
6●●▲▲●
(1)の異動元のB3の空白は移動後には左に詰めるようにし、移動後の内容でセル列Rを越える値は切り捨てるようにもしたいのです。こんな形でのマクロをご教授いただきたいのですが、よろしくお願いいたします。
No.3ベストアンサー
- 回答日時:
#1です。
>移動先の行に全く何も入力されていない空白があると…
なんか(いろいろと)変なことしてましたね。
すみません。修正しました。
>何行目までとかも指定はできますか?
下記コードで999となっている部分を書き換えてください。
なお、#1のコードで「9」を直接埋め込んでましたが、
それだとああいう書き方をした意味がありませんでした。
その辺も直しました。
もし遅すぎるようでしたらまた直しますので補足してください。
'---------------↓ ココカラ ↓---------------
Sub Sample0906112()
Dim myRng1 As Range
Dim myRng2 As Range
Dim i As Long
Dim j As Long
Dim k As Long
Set myRng1 = Range("A:I") 'A:I列を移す
Set myRng2 = Range("J:R") 'J:R列に移す
For i = 1 To 999 '1行目から999行目まで
For j = myRng2.Columns.Count To 1 Step -1
If myRng2(i, j).Value <> "" Then Exit For
Next j
j = j + 1
For k = 1 To myRng1.Columns.Count
If j > myRng2.Columns.Count Then Exit For
If myRng1(i, k).Value <> "" Then
myRng2(i, j).Value = myRng1(i, k).Value
j = j + 1
End If
Next k
myRng1.Rows(i).ClearContents
Next i
End Sub
'---------------↑ ココマデ ↑---------------
ありがとうございました!!私が思っていた通りに動作しました。初心者の私には全く思いつきようのないマクロです。本当にありがとうございました。
No.4
- 回答日時:
一例です
Sub test()
Dim i As Long, ii As Long
'-----------------------------------------
ii = 100 '←処理最終行を指定指定してください
'-----------------------------------------
For i = 1 To ii
If Range("s" & i).End(xlToLeft).Column < 10 Then
Cells(i, 1).Resize(1, 9).Copy Range("j" & i).Resize(1, 9)
Else
Cells(i, 1).Resize(1, 9).Copy Range("s" & i).End(xlToLeft).Offset(, 1).Resize(1, 9)
End If
Next i
Columns("S:AA").ClearContents
If WorksheetFunction.CountBlank(Range("J1:R" & ii)) = 0 Then Exit Sub
Range("J1:R" & ii).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub
参考まで
No.2
- 回答日時:
単純に左から見て行って、値が空白でなければコピーしてあげればよいだけではないのかな。
(意味が違っていたら無視願います)こんな感じ?(あとは適当に修正してください)
Sub test()
Dim rw As Long, col As Long, ctmp As Long
For rw = 1 To 6
ctmp = Cells(rw, Columns.Count).End(xlToLeft).Column + 1
If ctmp < 10 Then ctmp = 10
For col = 1 To 9
If Cells(rw, col).Value <> "" Then
Cells(rw, ctmp).Value = Cells(rw, col).Value
ctmp = ctmp + 1
End If
Next col
Next rw
End Sub
No.1
- 回答日時:
とりあえずこんな感じでいかがでしょうか。
●動作の概要
1行目から(A列の)最終行までの各行について、
A:I列の値をJ:R列のデータの後方に順序を維持して移動する。
・J:R列のデータはそのまま維持する
・A:I列について空白がある場合は無視する
・S列以降は使用しない
'---------------↓ ココカラ ↓---------------
Sub Sample090611()
Dim myAry1 As Variant
Dim myAry2 As Variant
Dim i As Long
Dim j As Long
Dim k As Long
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
myAry1 = Range("A:I").Rows(i).Value
Range("A:I").Rows(i).ClearContents
myAry2 = Range("J:R").Rows(i).Value
For j = 9 To 1 Step -1
If myAry2(1, j) <> "" Then
j = j + 1
Exit For
End If
Next j
For k = 1 To 9
If myAry1(1, k) <> "" Then
myAry2(1, j) = myAry1(1, k)
If j = 9 Then
Exit For
Else
j = j + 1
End If
End If
Next k
Range("J:R").Rows(i).Value = myAry2
Next i
End Sub
'---------------↑ ココマデ ↑---------------
Excel2003で動作確認。
この回答への補足
ありがとうございます。移動元、移動先の行に全く何も入力されていない空白があるとその下の行からは移動しないので『インデックスが有効な範囲にありません』と表示しますが、移動元、移動先の行が空白でも移動可能に出来ますか?後、1行目から(A列の)最終行まででなくて何行目までとかも指定はできますか?もし可能でしたらお教えいただきたいのです。ご無理を言いますがよろしくお願いいたします。
補足日時:2009/06/11 20:11お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Worksheets メソッドは失敗しま...
-
文字列の結合を空白行まで実行
-
1行づつデータを移動させたい
-
オートフィルタをマクロで作成...
-
【Excel VBA】 B列に特定の文字...
-
VBAの構文 3列置きにコピーし...
-
VBマクロ 色の付いたセルを...
-
Cellsのかっこの中はどっちが行...
-
エクセルVBA intersect colu...
-
A列にある値をB列・C列にVBAで...
-
VBAを用いて条件付きの平均値、...
-
[ASP+SQL]絞込み済みのレコード...
-
エクセルvbaについて
-
Excel-VBAで連番を振るマクロを...
-
VBA グラフX軸の変更
-
ExcelVBA修正のお願い
-
VB.NETのDataGridで、選択行の...
-
VBAで、離れた複数の列に対して...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
IIF関数の使い方
-
VBAを使って検索したセルをコピ...
-
Cellsのかっこの中はどっちが行...
-
文字列の結合を空白行まで実行
-
マクロ 最終列をコピーして最終...
-
URLのリンク切れをマクロを使っ...
-
Changeイベントでの複数セルの...
-
VBAのFind関数で結合セルを検索...
-
ExcelVBA修正のお願い
-
データグリッドビューの一番最...
-
VBAで指定範囲内の空白セルを左...
-
VBA 何かしら文字が入っていたら
-
【VBA】2つのシートの値を比較...
-
VBマクロ 色の付いたセルを...
-
空白セルをとばして転記
-
rowsとcolsの意味
おすすめ情報