A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
'(1)からはじまる文字列をA列に
'(2)からはじまる文字列をB列に
'(3)からはじまる文字列をC列に
'それ以外をD列に移動させる
'念のため初期のA列情報をH列にバックアップしておく
Option Option Explicit
Sub main()
Dim i As Long
Dim A As String
Dim B As String
Dim C As String
Dim D As String
Dim E As String
'A列のデータ分だけループをまわす
With Excel.Application.ActiveSheet
For i = 1 To .Range("$A$65536").End(xlUp).Row
'初期化
A = ""
B = ""
C = ""
D = ""
E = ""
'A列のコピー元の行
A = "A" & i
'B~Eは、最終使用行+1(=コピー先となる空白行)
B = "B" & .Range("$B$65536").End(xlUp).Row + 1
C = "C" & .Range("$C$65536").End(xlUp).Row + 1
D = "D" & .Range("$D$65536").End(xlUp).Row + 1
E = "E" & .Range("$E$65536").End(xlUp).Row + 1
'A列の先頭3文字によってコピー先を振り分ける
'ただし、B1~E1が空白の場合でも、.End(xlUp).Row が 1 になってしまうので、
'その場合のみアドレス直指定で対処
If Mid(.Range("A:A").Cells(i, 1).Value, 1, 3) = "(1)" Then
If Range("B1") = "" Then
Range(A).Copy Range("B1")
Else
Range(A).Copy Range(B)
End If
ElseIf Mid(.Range("A:A").Cells(i, 1).Value, 1, 3) = "(2)" Then
If Range("C1") = "" Then
Range(A).Copy Range("C1")
Else
Range(A).Copy Range(C)
End If
ElseIf Mid(.Range("A:A").Cells(i, 1).Value, 1, 3) = "(3)" Then
If Range("D1") = "" Then
Range(A).Copy Range("D1")
Else
Range(A).Copy Range(D)
End If
'(1)~(3)のどれでもない場合は、E列にコピー
Else
If Range("E1") = "" Then
Range(A).Copy Range("E1")
Else
Range(A).Copy Range(E)
End If
End If
Next
End With
'A列をG列にバックアップ
Range("A:A").Copy Range("G:G")
'A列を削除
Range("A:A").Delete
MsgBox "Program End"
End Sub
No.4
- 回答日時:
'3行ずつがセットになっていて2行目、3行目を1行目と同じ行の
'列方向持ってくるというだけなら。
Sub 処理()
Dim oSh As Worksheet
Dim i As Long, j As Long
Dim pLastRow As Long
Dim pMod As Long
Set oSh = Sheets("Sheet1") 'Sheet1には実際使っているシート名を入れる。
With oSh
pLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To pLastRow
pMod = i Mod 3
Select Case pMod
Case 0
.Range("C" & i - 2) = .Range("A" & i)
Case 1
'そのまま
Case 2
.Range("B" & i - 1) = .Range("A" & i)
End Select
Next i
For i = pLastRow To 1 Step -1
If .Range("B" & i) = "" Then
.Rows(i & ":" & i).Delete
End If
Next i
End With
Set oSh = Nothing
End Sub
No.3
- 回答日時:
こんな感じで
Sub test()
Dim i, ii, iii
Dim a
a = Range("a1", Cells(Rows.Count, 1).End(xlUp).Address)
Range("a1", Cells(Rows.Count, 1).End(xlUp).Address).ClearContents
iii = 1
For i = 1 To UBound(a, 1) / 3
For ii = 1 To 3
Cells(i, ii) = a(iii, 1)
iii = iii + 1
Next ii
Next i
End Sub
エラー処理、アレンジはご自分で
No.2
- 回答日時:
A列に並んでいるデータを単純に3つずつ並べなおすのと
データの内容によって移動先が変化するのかで
VBAの組み方もかわってきますが…
後者ならこんな感じでしょうか。
フローなコーディング版。
for(A1~Aの最終行)
セル内容判定
1番:B列に移動。
2番:C列に移動。
3番:D列に移動。
end for
A列削除。
実際にはB、C、Dの各列での現在行管理が必要です。
エラーなデータが存在していた場合の処理も
場合によっては必要でしょう。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Web画面の文字をVB6で取得したい
-
Excel 範囲指定スクショについ...
-
VBA 入力箇所指定方法
-
【VBA】カーソルのある行の1行...
-
VBA ユーザーフォーム ボタンク...
-
エクセルVBAにて =A1=B1とすれ...
-
【ExcelVBA】インデックスが有...
-
Excelについて
-
VBA 別ブックからコピペしたい...
-
VBA 別ブックから条件に合うも...
-
配列のペースト出力結果の書式...
-
Excelで画像URLを1つずつセル...
-
Excel VBA 文字列のセルを反映...
-
VBA 指定した回数分、別シート...
-
ExcelVBAのFindFirstエラ...
-
VBA 複数の各シートに行を追加...
-
10行目にフィルターを使用して...
-
Outlookの「受信日時」「件名」...
-
Excel VBAで値を変えながら、pd...
-
メールの件名をデコードしたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA 別ブックからコピペしたい...
-
Vba ファイル書き込み時に書き...
-
Excel_VBAについて質疑です。(...
-
VBAの間違い教えて下さい
-
VBA コードどこがおかしいですか?
-
VBA 円グラフ 特定条件に一致し...
-
VBA 別ブックから条件に合うも...
-
pdfファイルの複数添付 引数の型
-
【ExcelVBA】インデックスが有...
-
ExcelVBAマクロで実行した時の疑問
-
Vba UserformからExcelシートの...
-
VBA初心者です。次のVBAコード...
-
Outlookの「受信日時」「件名」...
-
Excel 範囲指定スクショについ...
-
vbs ブック共有を解除
-
配列のペースト出力結果の書式...
-
Excel VBAで値を変えながら、pd...
-
VB.net(VB)で、フォームにExcel...
-
vbaにてseleniumを使用したedge...
-
ExcelVBA シート名を複数セルか...
おすすめ情報