[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『一つのセルから結合したセルに貼り付ける』(結合)
お世話になります。
単独セルを結合したセルに貼り付ける方法はありますでしょうか。
A B C D E 1 2 3 4 5 6
のデータを
ABの結合 CDの結合 EFの結合 GHの結合 IJの結合 1 2 3 4 5 6
このような感じです。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
Sub test() Dim wk1 As Worksheet Dim wk2 As Worksheet Dim i As Long Dim j As Long
Set wk1 = Sheets("Sheet1") Set wk2 = Sheets("Sheet2")
For i = 1 To wk1.Cells(wk1.Rows.Count, "A").End(xlUp).Row For j = 0 To 4 wk2.Cells(i, j * 2 + 1).Value = wk1.Cells(i, j + 1).Value Next j Next i End Sub (???) 2016/08/18(木) 16:15
値だけで良いなら数式でも、
Sheet1のA1:E1にデータ、Sheet2が
ABの結合 CDの結合 EFの結合 GHの結合 IJの結合
となっているとして、Sheet2のA1に
=OFFSET(Sheet1!$A$1,0,FLOOR(COLUMN(A1)/2,1))
で右方にフィルコピー
(ウッシ) 2016/08/18(木) 16:20
>マクロを使って、1セルずつ代入するとか?
Sub test() Dim R As Range Dim D As Range
Set R = Worksheets("Sheet1").Range("A1") Set D = Worksheets("Sheet2").Range("A1")
Do Until R.Value = "" D.Value = R.Value Set R = R.Offset(, 1) Set D = D.Offset(, 1) Loop End Sub
とか?
(とおりすがり) 2016/08/18(木) 19:11
皆さん本当にありがとうございます。 大変なミスをしてしまいました。 最初の質問は行〜行の結合と例をだしましたが 実際は、Sheet1の列データーをSheet2に Sheet1のデータを行列を入れ替えて貼り付けることは出来るでしょうか。 (とおりすがり)さんのマクロ式での変更をお願いしたいと思います。
Sheet1
A B C D 1 東京 神奈川 千葉 埼玉 2 10 14 18 22 3 11 15 19 23 4 12 16 20 24 5 13 17 21 25
Sheet2
A B CD EF GH IJ 1 東京 10 11 12 13 2 神奈川 14 15 16 17 3 千葉 18 19 20 21 4 埼玉 22 23 24 25
(結合) 2016/08/18(木) 21:09
おはようございます。 後から思ったのですが (とおりすがり)さんのマクロ式での変更をお願いしたいと思います。 と入れた事は指名をしてしまった事になるのでしょうか それでしたら申し訳ございません。 (とおりすがり)さんの 式を利用して、どなたかのサポートが欲しかったのです。 学校内の事情分からずして大変申し訳ございません。 よろしくお願い致します。 (結合) 2016/08/19(金) 06:53
Sub test2() Dim RR As Range Dim R As Range Dim D As Range Dim Bc As Long
Set RR = Worksheets("Sheet1").Range("A1").CurrentRegion Bc = RR.Columns.Count Set R = RR.Range("A1") Set D = Worksheets("Sheet2").Range("A1")
Do Until R.Value = "" Do Until R.Value = "" D.Value = R.Value Set R = R.Offset(, 1) Set D = D.Offset(1) Loop Set R = R.Offset(1, -Bc) Set D = D.Offset(-Bc) Set D = D.Offset(, 1) Loop End Sub
面倒くさいから、以上で打ち止め。ww
(とおりすがり) 2016/08/19(金) 10:06
Sub test1()
Dim wk1 As Worksheet Dim wk2 As Worksheet Dim i As Long Dim j As Long Set wk1 = Sheets("Sheet1") Set wk2 = Sheets("Sheet2") With wk1 i = .Range("A1").End(xlToRight).Column j = .Range("A" & Rows.Count).End(xlUp).Row End With With wk2.Range("A1").Resize(i, j * 2) .Formula = _ "=OFFSET(Sheet1!$A$1,FLOOR(COLUMN(A1)/2,1),ROW(A1)-1)" .Value = .Value End With End Sub
こんな感じでも。
(ウッシ) 2016/08/19(金) 10:20
Sub test() Dim wk1 As Worksheet Dim wk2 As Worksheet Dim R As Range Dim D As Range Dim i As Long
Set wk1 = Sheets("Sheet1") Set wk2 = Sheets("Sheet2")
For i = 1 To wk1.Cells(1, wk1.Columns.Count).End(xlToLeft).Column Set R = wk1.Cells(1, i) Set D = wk2.Cells(i, 1) Do Until R.Value = "" D.Value = R.Value Set R = R.Offset(1) Set D = D.Offset(, 1) Loop Next i End Sub
こっちは、私自身の変更案。
Sub test2() Dim wk1 As Worksheet Dim wk2 As Worksheet Dim i As Long Dim j As Long Dim iMax As Long
Set wk1 = Sheets("Sheet1") Set wk2 = Sheets("Sheet2") iMax = wk1.Cells(1, wk1.Columns.Count).End(xlToLeft).Column
For i = 1 To wk1.Cells(wk1.Rows.Count, "A").End(xlUp).Row For j = 1 To iMax wk2.Cells(j, i * 2 - 1).Value = wk1.Cells(i, j).Value Next j Next i End Sub (???) 2016/08/19(金) 10:24
さすがは???さんですね、いやーお見事。 (変な意味ではなく本当に感心しています。ww)
(とおりすがり) 2016/08/19(金) 10:33
(???)さんの 2016/08/19(金) 10:24で解決いたしました。 改めてありがとうございました。 一つ謝らなければならない事があります。 一回ごとの質問でニックネームを入れ替えるのかと思い ニックネームを変更してしまいました。 言い訳がましいですが大変申し訳ございませんでした。 今後ともよろしくお願い致します。
追伸:今後は(日にち)で参加させて下さい。 申し訳ございませんでした。
(日にち) 2016/08/28(日) 10:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.