| |
こんにちは。
私もひとつ作ってみました。
Sub サンプル1()
Dim 開始行 As Long
Dim 最終行 As Long
Dim 上端行 As Long
Dim 下端行 As Long
Dim ビル名 As String
Dim 市名合成 As String
Dim i As Long
上端行 = 1
最終行 = Range("B65536").End(xlUp).Row
Do
ビル名 = Cells(上端行, "C").Value
'同じビル名がどこまで続くか調べる。
'(ワークシート関数MATCHとか逆検索とか出来そうだけどベタに探す)
下端行 = 上端行
Do
下端行 = 下端行 + 1
Loop Until (Cells(下端行, "C").Value <> ビル名) Or (下端行 > 最終行)
下端行 = 下端行 - 1
'上で求めた範囲の市名を合成する。
For i = 上端行 To 下端行
If i = 上端行 Then
市名合成 = Cells(i, "B").Value '最初の行はカンマはいらない
Else
市名合成 = 市名合成 & "," & Cells(i, "B").Value
End If
Next
'上で求めた範囲にビル名、市名を設定する。
For i = 上端行 To 下端行
Cells(i, "E").Value = 市名合成
Cells(i, "F").Value = ビル名
Next
'次のビルの処理をする。
上端行 = 下端行 + 1
Loop Until 上端行 > 最終行
MsgBox "おしまい"
End Sub
超ベタな方法なので行が多いと時間が掛かると思います。
|
|
へっぽこ
- 06/8/15(火) 12:18 -
