エクセルで頭が一緒のものは横のセルに移動したい場合どうすればいいでしょうか？

エクセルの知識が乏しくて申し訳ないですが質問お願いします。
　　A　　　B　　C
1　12A
2　12B
3　12C
4　13A
5　13B

----------------------
　　A　　　B　　C
1　12A　12B　12C
2　13A　13B

の用にしたい場合、どのような関数を使えばよいでしょうか？

No.2 ベストアンサー 回答者： tom04 回答日時： 2016/01/19 23:08

No.1です。

投稿後もう一度質問文を読み返してみると
元データのA列すべてを表示しなければいけないのですね？
前回はSheet2のA列に頭9桁を表示させ
その行のB列以降にアルファベット以降のを表示させていました。
↓のコードに変更してみてください。

Sub Sample2() 'この行から//
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS.Cells.Clear
With Worksheets("Sheet1")
.Rows(1).Insert
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B:C").Insert
With Range(.Cells(1, "B"), .Cells(lastRow, "B"))
.Formula = "=LEFT(A1,9)"
.Value = .Value
End With
With Range(.Cells(1, "C"), .Cells(lastRow, "C"))
.Formula = "=SUBSTITUTE(A1,B1,"""")"
.Value = .Value
End With
.Range("B1") = "ダミー"
.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
.Rows(1).AutoFilter field:=2, Criteria1:=wS.Cells(i, "A")
Range(.Cells(2, "A"), .Cells(lastRow, "A")).SpecialCells(xlCellTypeVisible).Copy '★
wS.Cells(i, "B").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
.Range("B:C").Delete
.Rows(1).Delete
wS.Rows(1).Delete
wS.Range("A:A").Delete '（追加）★
End With
wS.Columns.AutoFit
Application.ScreenUpdating = True
wS.Activate
End Sub 'この行まで//

※　コード内の★の行だけに手を加えています。m(_ _)m

この回答へのお礼

ありがとうございます。出来ました。手でコピーするには大量のデータでしたので大変助かりました。VBAですね。勉強して活用したいと思います。ありがとうございました。

お礼日時：2016/01/20 04:58

No.3 回答者： mike_g 回答日時： 2016/01/19 23:18

「頭」の定義(左から何文字目までとか、場合によって変わるなら「どんな場合にどうするとか)は？

No.1 回答者： tom04 回答日時： 2016/01/19 22:47

こんばんは！

画像を拝見すると
A列の1行目からデータがあり、頭から9桁のデータを1行にまとめたい！
というコトですよね？

関数でできるかもしれませんが、手っ取り早くVBAでやってみました。
元データはSheet1のA列にあり、Sheet2に表示させるとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）
マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から//
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS.Cells.Clear
With Worksheets("Sheet1")
.Rows(1).Insert
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B:C").Insert
With Range(.Cells(1, "B"), .Cells(lastRow, "B"))
.Formula = "=LEFT(A1,9)"
.Value = .Value
End With
With Range(.Cells(1, "C"), .Cells(lastRow, "C"))
.Formula = "=SUBSTITUTE(A1,B1,"""")"
.Value = .Value
End With
.Range("B1") = "ダミー"
.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
.Rows(1).AutoFilter field:=2, Criteria1:=wS.Cells(i, "A")
Range(.Cells(2, "C"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Copy
wS.Cells(i, "B").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
.Range("B:C").Delete
.Rows(1).Delete
wS.Rows(1).Delete
End With
wS.Columns.AutoFit
Application.ScreenUpdating = True
wS.Activate
End Sub 'この行まで//

※　関数でないのでデータ変更があるたびにマクロを実行する必要があります。
まずはこの程度で・・・m(_ _)m

この回答へのお礼

ありがとうございます。助かりました。

お礼日時：2016/01/20 12:40