こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

Excel2007の表形式を変更する良い方法は?

現在、以下の様な表があります。
大文字の部分が基本情報、小文字の部分が付加情報、といったイメージです。

A a1
A a2
A a3
B b1
B b2
C c1
C c2

これを、次のような表の形式に直すには、どのようにしたら手間がかからないでしょうか。

A a1 a2 a3
B b1 b2
C c1 c2

付加情報ごとに1行ずつ分割されている表を、基本情報単位でまとめたい、ということです。

※元の表の付加情報に関しては個数が決まっていません。
 最小で2個、最大で10個と幅があります。

良い案がありましたら、ご教授ください。
よろしくお願いします。

投稿日時 - 2012-05-30 14:23:20

QNo.7504684

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

No.1です。

>実際のデータはA列に基本情報、B列に付加情報のような・・・

とありますので、Sheet1は↓の画像の左側のような配置になっているというコトですよね?
そうであれば、前回より簡単です。

もう一度コードを載せてみます。
前回同様の操作でマクロを実行してみてください。

Sub test2()
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
Application.ScreenUpdating = False
k = ws.Cells(Rows.Count, 1).End(xlUp).Row
If k > 1 Then
ws.Rows(2 & ":" & k).ClearContents
End If
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(ws.Columns(1), Cells(i, 1)) = 0 Then
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Cells(i, 1)
End If
Next i
For k = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = ws.Cells(k, 1) Then
ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1) = Cells(i, 2)
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか?m(_ _)m

投稿日時 - 2012-05-31 21:18:26

ANo.1

こんにちは!
VBAになってしまいますが・・・
一例です。

Sheet1のA列にデータがあり、↓の画像のようにSheet2に表示するとします。
前提条件として大文字は1文字としています。

画面左下のSheet1のSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub test() 'この行から
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
Application.ScreenUpdating = False
k = ws.Cells(Rows.Count, 1).End(xlUp).Row
If k > 1 Then
ws.Rows(2 & ":" & k).ClearContents
End If
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(ws.Columns(1), Left(Cells(i, 1), 1)) = 0 Then
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Left(Cells(i, 1), 1)
End If
Next i
For k = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Left(Cells(i, 1), 1) = ws.Cells(k, 1) Then
ws.Cells(k, Columns.Count).End(xlToLeft).Offset(, 1) = _
Trim(Mid(Cells(i, 1), 2, Len(Cells(i, 1))))
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub 'この行まで

※ 大文字部が1文字以上も場合は別途コードをやり直す必要があります。
参考になりますかね?m(_ _)m

投稿日時 - 2012-05-30 15:38:19

お礼

回答有り難うございます。

実際のデータはA列に基本情報、B列に付加情報のような形になっていて(VBA実行後のようにセルに分かれているイメージです)、文字数も固定ではないので、少し修正が必要になりそうですが、頑張ってみます。

投稿日時 - 2012-05-31 20:28:07

あなたにオススメの質問