[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『横並びのデータを縦一列に並べ替え』（KI）
いつも楽しく勉強させていただいています。 下の例のように A:E列 にデータがあります。 これを、F列 一列に順番に表示させることは出来ますでしょうか？ 並べる条件としては、A1→B1→C1→D1→E1→A2→B2・・・ といった具合で、もし空白セルの場合は詰めていきます。 また、A列 には空白セルは存在しません。 宜しくお願い致します。
[A] [B] [C] [D] [E] [F] [1] 50 579 436 50 [2] 401 994 657 823 727 579 [3] 487 10 436 [4] 90 464 623 754 265 401 [5] 43 990 868 937 284 994 [6] 645 657 [7] 663 823 [8] 653 219 226 727 [9] 935 846 620 619 487 [10] 317 583 10 [11] 90
環境はExcel2003/2007です。
VBA案です。 以下のコードを標準モジュールに貼り付け、実行してみて下さい。
'__________________________________________________ Sub sample()
Dim lmt As Range, mydata() Dim r As Long, c As Long Dim cnt As Long, i As Long
Set lmt = ThisWorkbook.ActiveSheet.Range("A1:E10")
cnt = WorksheetFunction.CountA(lmt)
ReDim mydata(cnt)
For r = 1 To lmt.Rows.Count
For c = 1 To 5
If Cells(r, c).Value <> "" Then
mydata(i) = Cells(r, c).Value
i = i + 1
End If
Next c
Next r
Range("F1:F" & cnt) = WorksheetFunction.Transpose(mydata)
End Sub '__________________________________________________
(Dil)
若干の違いですが 範囲を選択してから実行してください。
Sub test()
Dim a, i As Long, ii As Long, x As Long, n As Long
With Selection
x = Application.Count(.Cells)
If x > 0 Then
ReDim b(1 To x, 1 To 1)
a = .Value
For i = 1 To .Rows.Count
For ii = 1 To .Columns.Count
If Not IsEmpty(a(i, ii)) Then
n = n + 1 : b(n, 1) = a(i, ii)
End If
Next ii, i
.Resize(n, 1).Offset(, .Columns.Count + 1).Value = b
End If
End with
End Sub
(seiya)
(Dil)さん、(seiya)さん 有難うございます。 早速試してみました。 Dilさんに提示いただいたマクロでは、元データのセルが空白の場合、 抽出後も空白セルとして表示されてしまいますが、元データが空白の 場合、抽出後は空白とせずに次の値を詰めて表示したいのですが・・・。 こんなことは無理なんでしょうか？
seiyaさんに提示いただいたマクロですが、試してみた処なぜか次のような エラーになってしまいます↓
「インデックスが有効範囲にありません」
おそらく、私のやり方がいけないんだと思いますが・・・？ 宜しくお願い致します。 (KI)
これではどうでしょう？
Sub test()
Dim a, i As Long, ii As Long, x As Long, n As Long
With Selection
x = Application.Count(.Cells)
If x > 0 Then
ReDim b(1 To .Rows.Count * .Columns.Count, 1 To 1)
a = .Value
For i = 1 To .Rows.Count
For ii = 1 To .Columns.Count
If Not IsEmpty(a(i, ii)) Then
n = n + 1 : b(n, 1) = a(i, ii)
End If
Next ii, i
If n > 0 Then .Resize(n, 1).Offset(, .Columns.Count + 1).Value = b
End If
End with
End Sub
(seiya)
seiyaさん、 有難うございます。
[A] [B] [C] [D] [E] [F] [G]
[1] 50 579 436 50
[2] 401 994 657 823 727 579
[3] 487 10 436
[4] 90 464 623 754 265
[5] 43 990 868 937 284
[6] 645 401
[7] 663 994
[8] 653 219 226 657
[9] 935 846 620 619 823
[10] 317 583 727
[11] 487
[12] 10
A1:E10を選択してマクロを実行したところ、G列には↑のように
結果が返ってきましたが、G4とG5が空白となります。
この空白をなくして、G6の401をG4に詰めて表示出来たらと思うのですが・・・？
(KI)
空白セルに何か入っていませんか？（スペースとか？）
これで試してください
Sub test()
Dim a, i As Long, ii As Long, x As Long, n As Long
With Selection
.Value = .Value
x = Application.Count(.Cells)
If x > 0 Then
ReDim b(1 To .Rows.Count * .Columns.Count, 1 To 1)
a = .Value
For i = 1 To .Rows.Count
For ii = 1 To .Columns.Count
If Trim(a(i, ii)) <> "" Then
n = n + 1 : b(n, 1) = a(i, ii)
End If
Next ii, i
If n > 0 Then .Resize(n, 1).Offset(, .Columns.Count + 1).Value = b
End If
End with
End Sub
(seiya)
とと、衝突しましたがそのまま。
>Dilさんに提示いただいたマクロでは、元データのセルが空白の場合、 >抽出後も空白セルとして表示されてしまいます
んん・・・？ご提示頂いたレイアウトで試したところ、こちらではうまくいきます。 空白のセルには、何か数式が入ってますか？
If Cells(r, c).Value <> "" Then の部分を If Len(Cells(r, c)) <> 0 Then に変えるとどうでしょうか？
(Dil)
(Dil)さん、(seiya)さん
すみませ～ん、空白セルと思っていたらスペースがありました。
確認もせずにすみませんでした。
お二方のマクロでどちらも共に、希望通りに出来ました。
本当に有難うございました。今後とも宜しくお願いします。
(KI)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.