現在エクセル上で以下の様なデータ処理を行っています。
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で質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
VBA ソートすると、1、11、...
-
相対参照から絶対参照に変換す...
-
最適な組み合わせの自動計算
-
データの平均を1分値にまとめる...
-
別ブックの空白行に転記
-
エクセル・VBAで決められたルー...
-
Word 黒塗り部分の文字のみ削除...
-
YmobileからSoftbankに乗り換え...
-
エクセルのマクロの作り方で、...
-
エクセル最終行の下に貼り付け
-
射精したあとの匂いって他人に...
-
1日3回セックスって多いですか...
-
彼女をオカズにして抜くのって...
-
おっぱいを舐める
-
彼とのエッチで、彼がイクのが...
-
夫にセックスがないのなら他人...
-
先日彼氏とラブホに行ったら電...
-
2人でエッチできる場所を探して...
-
あそこって・・みんな 舐める?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
既婚で現役のAV女優さんは居ま...
-
VBA ソートすると、1、11、...
-
シンナーの夏型と冬型の違いは?
-
CDレコの曲の消し方を教えてく...
-
EXCELで3行を一組にして結合す...
-
Word 黒塗り部分の文字のみ削除...
-
VBAが止まります。
-
エクセル最終行の下に貼り付け
-
相対参照から絶対参照に変換す...
-
別ブックの空白行に転記
-
大昔から、クンニ、フェラって...
-
直線コネクタの中央にコネクタ...
-
scilabのエラーに関して
-
最適な組み合わせの自動計算
-
Galaxy s10とGalaxy A41はどち...
-
データの平均を1分値にまとめる...
-
ExcelVBAで指定文字(この場合...
-
エクセルのマクロについて
-
性欲自体はあるのにセックスで...
-
エクセルのマクロの作り方で、...
おすすめ情報