| |
興味深いので、作成してみました。
Yukiさんのは、必要なデータのみコピーする方式ですが、
質問者さんは Sheet2をそのままコピーして、あとから削除する方式。
私もYukiさん方式を採用するだろうが、一応、質問者さん方式で作成しました。
また、質問の最初にあるように結合セルをあえて対象にしています。
■問題の説明（改めて）
<<Sheet1>>
A B C
1 No. 名前 性別
2 A01 梅尾 女
3 A02 福田 男
4 B01 石川 女
5 B02 森田 男
<<Sheet2>>
A B C D E
1
2 タイトル
3 番号 No. 住所 年齢 特徴
4
5 1 A01 東京 19歳 国語が得意
20 2 A02 鹿児島 19歳 国語、国語、英語、数学、運動が得意
35 3 A03 米国 19歳 数学が得意
(なお、3〜4行目はセル結合されている。
5〜19,20〜34,35〜49行のA〜D列は、セル結合されています。
------------------------------
やりたいことは、
・Sheet2をコピーした Resultシートを作成し、
・以下のように、
B列とC列の間に、(No.に対応してSheet1で得られる)名前を挿入することです。
<<Result>>
A B C D E F
1
2 タイトル
3 番号 No. 名前 住所 年齢 特徴
4
5 1 A01 梅尾 東京 19歳 国語が得意
20 2 A02 福田 鹿児島 19歳 国語、国語、英語、数学、運動が得意
(なお、セル結合はSheet2と同じ。1データが15行に渡って結合されている。）
-------------
手順:
1. Sheet2をコピーして Resultシートを作成
2. ResultシートのB列をC列に挿入コピー（それより右の列は右側に移動）
3. Resultシートについて以下の作業を行う。
(1)B列のデータあり最終行を求める。
(2)その行から、5行目までについて、15行おきに下から、以下の作業を繰り返す。
(2)そのセルのNo.がSheet1にあれば、それに対応する「名前」をC列に上書き。
(3)そのセルのNo.がSheet1になければ、そのセルの行から始まる15行を削除する。
-------------
参考コード（あえてDictionaryを使わない方式）
Sub test2()
Dim resWS As Worksheet
Dim k As Long
Dim lastRow As Long
Dim s As String
Dim v
Worksheets("Sheet2").Copy after:=Worksheets("Sheet2")
Set resWS = ActiveSheet
resWS.Name = "RESULT"
With resWS
.Columns("B").Copy
.Columns("C").Insert Shift:=xlToRight
.Range("C3").Value = "名前"
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
For k = lastRow To 5 Step -15
s = .Cells(k, 2).Value
v = Application.VLookup(s, Worksheets("Sheet1").Range("A:C"), _
2, False)
If Not IsError(v) Then
.Cells(k, 3).Value = v
Else
.Cells(k, 1).Resize(15, 1).EntireRow.Delete
End If
Next
End With
End Sub
なお、セル結合は、ソートしたくても簡単にはできないし、
データ部分をセル結合するのは避けた方が得だと思う。
-------------
それから、
> しかし、今回の場合、本を見ても、そのまま使える例が無く、また応用も出来ませんでした。
> どうやれば、このようなコードが書けるようになるのでしょうか？
> もっと例題の多い本やネットのサイト等があるのでしょうか？
についてひとこと。
そのまま写せば済むようなら誰も苦労しません。現実はそれなりに複雑です。
そう難しくもないだろうが、舐めてかかってできるものでもない。
ネットのどこかに答えが書いてあるわけでもありません。
面倒でも、ひとつひとつのケースを深掘りして経験を蓄積していくしかありません。
他人とのやりとりも一字一句を正確に記述する、
そのような、ある意味で辛気くさいことを実行する覚悟がないと、簡単には行きません。
しかし、掛けた労力は必ずきちんと返って来るはずです。
|
|
γ
- 14/5/18(日) 22:25 -
