[[20140420200218]] 『複数列のデータを縦1列に並べ替えたい。』(yama246) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数列のデータを縦1列に並べ替えたい。』(yama246)

複数列にあるデータを縦一列にしてテキストに書き出すものです。
例として横2列にしましたが、A1 B1 A2 B2というふうに縦1列にし、かつ空白行は詰めます。
よろしくお願いします。

A1 A1233 B1 B221
A2 A1234 B2
A3 A1235 B3 B222
A4 A1236 B4
A5 A1237 B5
A6 A1238 B6 B225

A1233
B221
A1234
A1235
B222
A1236
A1237
A1238
B225

< 使用 Excel:Excel2013、使用 OS:Windows7 >


書き忘れましたが、Bの空白セルはif関数式により(C1="","",)求められた結果で、完全空白ではなくA列、B列とも関数式が入っています。
(yama246) 2014/04/20(日) 21:01

こんなのありました。
  
http://officetanaka.net/excel/function/tips/tips66.htm
  
(マナ) 2014/04/20(日) 21:41

 どこに入力するのかわかりませんが・・・
 また、あまりおすすめしませんが(作業用列を使用した方が良いと思います)

 =IF(COUNTIF($A$1:$B$6,">""")<ROW(A1),"",INDEX($A$1:$B$6,INT(SMALL(IF($A$1:$B$6<>"",ROW($A$1:$B$6)*10+COLUMN($A$1:$B$6),""),ROW(A1))/10),MOD(SMALL(IF($A$1:$B$6<>"",ROW($A$1:$B$6)*10+COLUMN($A$1:$B$6),""),ROW(A1)),10)))
 配列数式です

(By) 2014/04/20(日) 21:45


こんばんは

標準モジュールに貼り付け、範囲選択して実行。
(2列でも、3列でも、4列でも対応します。)
sheet1 A10から書き出します。

Sub 縦1列に並べ替()

  Dim v As Range
  R = 10
   For Each v In Selection
      If v <> "" Then
   Worksheets("sheet1").Cells(R, "A") = v
   R = R + 1
  End If
 Next
End Sub
(五線譜) 2014/04/21(月) 02:22

マナさんありがうございました。
明治時代からの定番ですね。(たしかに)
手動のようなのでよく読んでみたいと思います。VBAでうごかせたらいいんですけどね。

五線譜さんありがうございました。
やってみたのですが「Worksheets("sheet1").Cells(R, "A") = vで「インデックスが有効範囲にない」
と出てしまうのですが。
それと 「A10から書き出し」というのは結果の書き出し位置でしょうか。データが1000行くらいあるのですが、これはどこで指定すればいいでしょうか。
また範囲の開始位置は「範囲を選択」ということなので、必ずしもA1からでなくてもいいんですね?

それと、できれば質問にあるようにシート上でなくテキストへの書き出しにしたいのですが。
テキストの保存フォルダとかファイル名指定をする必要があるかもしれません。
また空白セルの削除はどの部分で記述していますでしょうか。

(By)さんありがうございました。
トライしてみます。
(yama246) 2014/04/21(月) 06:01


五線譜さん
書き出し位置というのは
R = 10のことですね。これを10000にしてみました。
ただいずれにしてもエラーは出てしまいました。
(yama246) 2014/04/21(月) 06:25

五線譜さん
エラーはsheet1を作成することで解決しました。
これは「空白セル」は特に記述がなくても自動削除されているのでしょうか。
テキストへの書き出しは、sheet1からの手動貼り付けでも利用は可能なので、記述が大変のようでしたら
このまま使いたいと思います。範囲選択で自由にできるのがいいですね。

(yama246) 2014/04/21(月) 06:37


五線譜さんたびたびすみません。
この範囲指定のやりかたで、
A列全部の下にB列…C列と並べ替えるのはどのようにできますか。
この場合は空白セルは削除しないままですが、全列が空白(関数式あり)でしたら行削除します。
(yama246) 2014/04/21(月) 07:47

 単純に

 Sub test()
     Dim a, b, i As Long, ii As Long, n As Long
     a = ActiveSheet.UsedRange.Value
     ReDim b(1 To UBound(a, 1) * UBound(a, 2))
     For i = 1 To UBound(a, 1)
         For ii = 1 To UBound(a, 2)
             If a(i, ii) <> "" Then n = n + 1: b(n) = a(i, ii)
     Next ii, i
     If n > 0 Then
         ReDim Preserve b(n)
         Open Replace(ThisWorkbook.FullName, ".xlsm", ".txt") For Output As #1
             Print #1, Join(b, vbCrLf)
         Close #1
     Else
         MsgBox "No data"
     End If
 End Sub
(seiya) 2014/04/21(月) 07:49

seiyaさんありがうございました。
テキストはできましたが、セルの読込みが範囲外のセル(B列とC列を対象とした場合、A列のデータ)も入ってしまいました。対象の列はどこで指定すればいいでしょうか。
(例えばA列からF列までデータが入っている場合、CとDのみを対象として並び替えをしたい)

(yama246) 2014/04/21(月) 19:31


 >      a = ActiveSheet.UsedRange.Value
 を
     With ActiveSheet
        a = Intersect(.UsedRange, .Columns("c:d")).Value
     End With
 でOKでしょう。
(seiya) 2014/04/22(火) 07:50


seiyaさん
お手数をおかけしました。
おかげさまでできました。
どうもありがとうございました。
(yama246) 2014/04/22(火) 11:17

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.