![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?c9bd177)
現在エクセル上で以下の様なデータ処理を行っています。
c05
p2
v1
v5
空白セル
b07
b11
空白セル
b07
空白セル
a06
a07
a09
i1
i6
j8
p9
s1
というデータを
c05p2v1v5
p2v1v5
v1v5
v5
空白セル
b07b11
b11
空白セル
b07
空白セル
a06a07a09i1i6j8p9 s1
a07a09i1i6j8p9s1
a09i1i6j8p9s1
i1i6j8p9s1
i6j8p9s1
j8p9s1
p9s1
s1
とこのように転置を行いたいと考えています。
数千行ならばマクロの記録などを利用しやる事も出来るのですが、データ量が50万行と非常に多いのでこれらの作業を一括で行いたいと思い質問させて頂きました。
このような作業をするにはVBAでやるのが早いと思うのですが、どのような処理をさせたらいいのでしょうか?
またなにか参考になるサイト・参考書等がありましたら教えてください。
A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
>転置
Transposeといウと思うが、エクセルでは特別な意味がある。適当でない。「並べ替え組み合わせ」程度の表現が良いかと。
>長々と質問に例を挙げていて、それなりに理解の助けになるが、どういう仕組みかを考え、質問に文章でも表現するクセをつけないと。
ーー
空白まで行数をnとして、最上行から数えて、n、n-1,n-2、・・・2,1個取るが、x個を取る行数を1つずつ下げている。
こういうことでよいのかな。
ーー
例データ A列A1:A18
c05
p2
v1
v5
b07
b11
b07
a06
a07
a09
i1
i6
j8
p9
s1
ーー
標準モジュールに
Sub test01()
d = Range("a65536").End(xlUp).Row
MsgBox d
s = 1 'スタートセル
k = 1 '結果のスタート行
m = 8 '結果のスタート列
Range("A1").Select
Range("a1:A100").Select '範囲を100行と仮定
'---以下繰り返し
Do While s < d
n = Selection.Find(What:="").Row 'A列で空白行を見つける
l = n - s '空白から空白までのセル数
MsgBox n
For i = 0 To l - 1
For j = s + i To n
Cells(k, m) = Cells(j, "A")
m = m + 1 '1列右へ
Next j
m = 8 '結果のスタート列
k = k + 1 '一行下へ
Next i
'--検索範囲の取り直し
Range(Cells(n + 1, "A"), Cells(100, "A")).Select
s = n + 1 'スタートセルを設定し直し
Loop
End Sub
ーー
結果(この場合H列から右に)
c05p2v1v5
p2v1v5
v1v5
v5
b07b11
b11
b07
a06a07a09i1i6j8p9s1
a07a09i1i6j8p9s1
a09i1i6j8p9s1
i1i6j8p9s1
i6j8p9s1
j8p9s1
p9s1
s1
少しの修正で済むはずだが、これを本番用に作り直せるかな。
なるべく範囲のスタートとエンドを小刻みに分割して、実行することをお勧めする。
こういう2重ループのロジックのプログラムは相当慣れないと混乱すると思うが、行数が少なくはなる。
なおMsgboxは確認用なので、本番ではその行を削除のこと。
No.5
- 回答日時:
#04です。
#04のマクロよりも#02さんの回答の方がアルゴリズムは圧倒的に優れています。脱帽です。
そこで#04を書き換えました。別シートに書き込むところは先の回答と一緒ですので3、4行目を修正してください
Sub Macro2()
Dim idx, cnt As Long
Const sht As String = "Sheet2"
Const clm As String = "A"
Application.ScreenUpdating = False
With ActiveSheet
For idx = .Cells(.Rows.Count, clm).End(xlUp).Row To 1 Step -1
If .Cells(idx, clm).Value = "" Then
cnt = 0
Else
Sheets(sht).Cells(idx, 1).Value = .Cells(idx, clm)
If cnt > 0 Then
Sheets(sht).Cells(idx + 1, clm).Resize(1, cnt).Copy Sheets(sht).Cells(idx, 2)
End If
cnt = cnt + 1
End If
Next idx
End With
Application.ScreenUpdating = True
End Sub
No.4
- 回答日時:
>どのような処理をさせたらいいのでしょうか?
プログラムの経験はおありですか? もしあまり経験がないなら、アルゴリズムを考えるのがかなりつらいと思いましたので、とりあえずサンプルを書きました。
以下のマクロをALT+F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行は元データが入力されているシート画面に戻ってALT+F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。
(2007なら開発リボンは表示しておいてくださいね)
並べ替え結果は別シートに書き込むようにしました。マクロの5、6行目は実際の列名とシート名に変更してください
Sub Macro1()
Dim idx, frm, cnt As Long
Dim ptr2, idx2 As Long
Const clm As String = "A" '元データが書かれている列名
Const sht As String = "Sheet2" '並び替え結果を書き込むシート名
Application.ScreenUpdating = False
frm = 0
cnt = 0
ptr2 = Sheets(sht).Cells(Sheets(sht).Rows.Count, "A").End(xlUp).Row + 1
With ActiveSheet
For idx = 1 To .Cells(.Rows.Count, clm).End(xlUp).Row + 1
If .Cells(idx, clm) <> "" Then
cnt = cnt + 1
If frm = 0 Then
frm = idx
End If
Else
If cnt > 0 Then
.Cells(frm, clm).Resize(cnt).Copy Sheets(sht).Cells(ptr2, "A")
For idx2 = 1 To cnt - 1
Sheets(sht).Cells(ptr2, "A").Offset(idx2, 0).Resize(cnt - idx2).Copy _
Destination:=Sheets(sht).Cells(ptr2, "A").Offset(0, idx2)
Next idx2
ptr2 = ptr2 + cnt + 1
frm = 0
cnt = 0
End If
End If
Next idx
End With
Application.ScreenUpdating = True
End Sub
なお「マクロが分からないから解説、修正してください」はナシです。
それはご自身がマクロを勉強して行ってください。エラーが発生した場合はその限りではありません。
No.2
- 回答日時:
c05 p2 v1 v5
というのが、
A1=c05,B1=p2,C1=v1,D1=v5
なのか、
A1=c05 p2 v1 v5
なのかわからないので、両方考えました。
考え方としては、最後の行から処理した方が楽だという事です。
-----------------------
'cell毎にデータを配置する場合
Sub test1()
Dim ws As Worksheet
Dim row As Long
Dim w As Integer
Set ws = Worksheets("sheet1") '目的のシート
For row = ws.Cells(ws.Rows.Count, 1).End(xlUp).row To 1 Step -1
If ws.Cells(row, 1) = "" Then
w = 0
Else
w = w + 1
If w > 1 Then
ws.Range(ws.Cells(row + 1, 1), ws.Cells(row + 1, w - 1)).Copy Destination:=ws.Cells(row, 2)
End If
End If
Next
End Sub
-----------------------
'A列にデータを配置する場合
Sub test2()
Dim ws As Worksheet
Dim row As Long
Dim w As Integer
Set ws = Worksheets("sheet1") '目的のシート
For row = ws.Cells(ws.Rows.Count, 1).End(xlUp).row To 1 Step -1
If ws.Cells(row, 1) = "" Then
w = 0
Else
w = w + 1
If w > 1 Then
ws.Cells(row, 1) = ws.Cells(row, 1) & " " & ws.Cells(row + 1, 1)
End If
End If
Next
End Sub
p.s.
excel2000で試しました・・・
No.1
- 回答日時:
ヒント
セルのコピー1
Cells(1,2)=Cells(2,1)でA2セルの内容をB1にコピー。
セルのコピー2
Cells(1,2)=Cells(2,1) & " " & Cells(3,1)でA2セル、スペース、A3セルとしてB1にコピー。
空白セルの判断
If Cells(2,1)="" Then
~~
End If
A2セルが空白なら~~を実行します。
繰り返し
For i=1 To 50000
~~~
Next i
iを1,2,3,4・・・と変化させながら~~~を実行する。
途中で終わらせたいときは、Exit Forとする。
以上を組み合わせれば、作れます。
でも、よく見たら50万行のデータはエクセルの1シートでは処理できません。
複数シートに分かれていて全部で50万行ですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセル表作成について 5 2023/03/12 13:25
- Visual Basic(VBA) 該当セルに行替えを含むデータを命令文に入れて、2行に表示したい。 5 2023/07/20 11:51
- Excel(エクセル) 複数セルデータを別シートの単一セルにコピーしたい。(詳細をご参照ください) 1 2022/12/14 15:08
- Visual Basic(VBA) エクセルVBAで教えて頂きたいのですが? 2 2022/12/31 20:28
- Excel(エクセル) エクセルの関数式を教えてください。 2 2022/11/29 21:09
- Excel(エクセル) Excel あらかじめ予定表があり、その月毎のセルに、リストの連続データを入れたい 2 2022/04/07 14:20
- Excel(エクセル) WORKDAY関数 4 2023/06/08 13:23
- Visual Basic(VBA) 【VBA】Excelで罫線を引きたい 3 2022/07/14 12:04
- Visual Basic(VBA) エクセルVBAで『A列』に新規で数値を入力し『B列』から右方向の空白セルにその値を貼り付ける方法 4 2022/11/05 08:37
- Excel(エクセル) Excel VBA 空白行があるセル範囲に色を付ける 3 2022/06/13 15:58
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
VBA ソートすると、1、11、...
-
Range表現
-
大昔から、クンニ、フェラって...
-
VBAが止まります。
-
エクセル最終行の下に貼り付け
-
シンナーの夏型と冬型の違いは?
-
射精したあとの匂いって他人に...
-
おっぱいを舐める
-
先日彼氏とラブホに行ったら電...
-
夫にセックスがないのなら他人...
-
精液のにおいがほとんど無いの...
-
彼女をオカズにして抜くのって...
-
彼とのエッチで、彼がイクのが...
-
1日3回セックスって多いですか...
-
手マンした手って臭いですか?
-
手マンしたあと それとなく指の...
-
女性は電マ、ローター、バイブ...
-
男の精子ってどんな匂いですか、
-
彼氏に顔射されて悲しいです
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
VBA ソートすると、1、11、...
-
CDレコの曲の消し方を教えてく...
-
大昔から、クンニ、フェラって...
-
シンナーの夏型と冬型の違いは?
-
VBAが止まります。
-
別ブックの空白行に転記
-
エクセル最終行の下に貼り付け
-
相対参照から絶対参照に変換す...
-
女性が頼まれなくてもフェラす...
-
ExcelVBAで指定文字(この場合...
-
直線コネクタの中央にコネクタ...
-
最適な組み合わせの自動計算
-
bluetoothのclass1とclass2の互...
-
私は今年で60歳で孤独です。40...
-
Word 黒塗り部分の文字のみ削除...
-
Excelで抽出・連続印刷したいです
-
EXCELで3行を一組にして結合す...
-
とても初歩的な質問
-
scilabのエラーに関して
おすすめ情報