人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelで下記のような表があったとします。

a,b,c,d,
e,f,g,h,
i,j,k,l,

(,がセルの区切り、改行が次列、a-lがセル内の値だと思ってください)

下記のように作り変えるのに手っ取り早い方法はありませんか?

a,b,c,d,e,
f,g,h,i,j,
k,l,

●質問者: hina1981
●カテゴリ:コンピュータ
✍キーワード:Excel セル
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● uni90210
●15ポイント

a-lを一列に貼り付けて、改行分を切り貼りし直すしかないのでは・・・。

◎質問者からの返答

ありがとうございます。

やっぱり、その方法しかないのですかね?。

Excelそのものに便利な機能が搭載されていたらいいな?、と思ったのですが……。


2 ● chipmunk1984
●30ポイント

http://homepage3.nifty.com/dkcsv/soft/csv/

CSVファイルにはき出して,量が多ければプログラムでいじりますかね.量が少なければテキストエディタでもいじれると思います.

◎質問者からの返答

ありがとうございます。

プログラムでいじるという発想は出てきませんでした。

一度作っておけば使い回しができるし、便利そうですね。


3 ● gong1971
●35ポイント ベストアンサー

4列ごとのデータを5列ごとに詰めたいという事ですよね。

複雑な数式になってしまいますが、以下の手順で可能です。


Sheet1 の A1 からデータが始まっているとして、

Sheet2 の A1 に以下の数式を入力します。

=OFFSET(Sheet1!$A$1,INT((ROW()*5+COLUMN()-6)/4),MOD(ROW()*5+COLUMN()-6,4))

この数式を入力したセルを B1:E1 にコピーし、

A1:E1 を必要行数分、下方向にコピーします。


Sheet1 の元のデータが B2 から始まっている場合は、

数式中の Sheet1!$A$1 を Sheet1!$B$2 と変更してください。

数式を入力する Sheet2 は必ず A1 から始めてください。


このままでは数式なので、必要に応じて値貼り付けを

行えばOKです。不明な点がありましたら返答で教えてください。

◎質問者からの返答

ありがとうございます。

関数でもできないかと考えて挫折していました。

どういうことをやっているのかは、なんとなくわかります。

引数の値を変えれば、かなり自由度があがりそうですね。


4 ●
●30ポイント

EXCELのマクロ(VBA)でもOKであれば、以下のようなソースでいかがでしょう。

ダイアログに変更後の列数を指定すると、自動的に変換を行います。

ただし、セルが空欄であるかどうかを条件として使っているので、値が含まれないセルがあると正しく動作しません。

(変更前の列数も手動で取得するようにすれば、空欄のセルを含んだデータにも対応できるように書き換えることは可能かもしれません。)

Windowsの場合、Alt+F11でMicrosoft Visual Basic Editorを開き、[挿入(I}]-[標準モジュール(M)]としてModule1の画面を開きます。

そこに以下のソースをコピー、ペーストして保存してください。

EXCELの画面でAlt+F8とするとマクロ実行のダイアログが出てきますので、「列数変更」を選んで実行してみてください。

Sub 列数変更()
'
' 変数の定義
'
Dim colNum As Integer
Dim rowNum As Integer
Dim maxColNum As Integer
Dim msg1 As String
Dim msg2 As String
Dim fromMaxColNum As Integer ' 変更前の列数
Dim toMaxColNum As Integer ' 変更後の列数
colNum = 1
rowNum = 1
' 変更後の列数の設定 (InputBox)
msg = "変更後の列数 : "
toMaxColNum = Application.InputBox(msg, "変更後の列数指定", , , , , , Type:=1)
If toMaxColNum = False Then Exit Sub
' 現在の列数の取得
' 1行目の内容をチェック
' 最初に空欄が見つかった列の1つ前の列の列番号を列数として取得
Dim i As Integer
i = 1
While (Cells(1, i).Value <> "")
 i = i + 1
Wend
fromMaxColNum = i - 1
' toMaxColNumの値がfromMaxColNumより大きい場合の処理
If toMaxColNum > fromMaxColNum Then
 ' 繰り返し処理
 ' 作業対象行の次の行の1列目の値が空欄でない間、処理を実行
 While (Cells(rowNum + 1, 1).Value <> "")
 ' 指定した列数以下の間、処理を実行
 While (colNum <= toMaxColNum)
 ' 対象のセルの値がブランクの場合、次の行の1列目の値をセット
 ' 1列目を削除し、左に詰める
 If Cells(rowNum, colNum).Value = "" Then
 Cells(rowNum, colNum).Value = Cells(rowNum + 1, 1).Value
 Cells(rowNum + 1, 1).Delete Shift:=xlToLeft
 ' 次の行の1列目の値がブランクの場合、次の行を削除
 If Cells(rowNum + 1, 1).Value = "" Then
 Cells(rowNum + 1, 1).EntireRow.Delete
 End If
 colNum = colNum + 1
 Else
 colNum = colNum + 1
 End If
 Wend
 colNum = 1
 rowNum = rowNum + 1
 Wend
 Cells(1, 1).Select
' toMaxColNumの値がfromMaxColNumより小さい場合の処理
ElseIf toMaxColNum < fromMaxColNum Then
 ' 繰り返し処理
 ' 作業対象行のtoMaxColNumの次の列の値が空欄でない間、処理を実行
 While (Cells(rowNum, toMaxColNum + 1).Value <> "")
 ' 対象列が最終列でない場合の処理
 ' toMaxColNumの次の列から最終列までを切り取り、次の行の先頭にセット
 If Cells(rowNum, toMaxColNum + 2).Value <> "" Then
 Cells(rowNum, toMaxColNum + 1).Select
 Range(Selection, Selection.End(xlToRight)).Cut
 Cells(rowNum + 1, 1).Insert Shift:=xlToRight
 rowNum = rowNum + 1
 ' 対象列が最終列の場合の処理
 ' 対象列を切り取り、次の行の先頭にセット
 Else
 Cells(rowNum, toMaxColNum + 1).Cut
 Cells(rowNum + 1, 1).Insert Shift:=xlToRight
 rowNum = rowNum + 1
 End If
 Wend
 Cells(1, 1).Select
End If
End Sub

参考になれば幸いです。

◎質問者からの返答

わざわざ作っていただき、ありがとうございます。

一度、作っておけばかなり使いまわせますね。

今後、使ってみます。

ありがとうございます。


5 ● gong1971
●20ポイント

回答3 の者です。ついでにVBAで作成してみました。

頻繁に使われるようであれば、こちらの方が便利かも。


使用方法は以下の通り。

  1. 範囲を選択し[ツール]メニューから[マクロ]の[マクロ]で、マクロ名[main]を実行。
  2. 結果がクリップボードに入るので、希望の位置で[貼り付け]を行う。

※ちなみに選択するセル範囲は4列でなくてもOKです。(結果は5列で返されます)


設定方法は以下の通り

  1. 下記urlを参照し標準モジュールを挿入します。
  2. [ツール]メニューから[参照設定]の画面を開き、"Microsoft Scripting Runtime"のチェックを入れます。
  3. 標準モジュールに下記のコードを記述します。

http://www.moug.net/skillup/ebb/evbb/evbb012-2.htm

Sub main()
 
 Dim CB As New DataObject
 Dim rg As Range
 Dim tx As String
 Dim i As Integer
 
 i = 0
 For Each rg In Selection
 If i Mod 5 = 4 Then
 tx = tx & rg.Value & vbLf
 i = 0
 Else
 tx = tx & rg.Value & vbTab
 i = i + 1
 End If
 Next
 With CB
 .SetText tx
 .PutInClipboard
 End With
End Sub
◎質問者からの返答

ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ