セルの文字列を取り出して一つのセルに入れる方法

質問

セルの文字列を取り出して一つのセルに入れる方法

こんにちは。
VBAの初心者のものです。
データ整理をしていたのですが、
次の様な場合、どのようにすればいいでしょうか。

例）
年度別、都道府県別の地震の発生件数のデータがあります。
これで１９９９年の地震が起こった都道府県を抽出するとします。
１９９９年の列でオートフィルタをかけ別のシートでまとめようと思います。

各年度でオートフィルタをかけて、次のようにまとめます。

１９９９年　北海道、宮城県、東京都
２０００年　新潟県、静岡県、岡山県、石川県
２００１年　福島県、宮城県、千葉県
２００２年　愛知県、三重県、京都府

なお、都道府県のところはできれば一つのセルにいれたいと考えています。

１９９９年の場合なら
Range("").value=北海道のセル&"、"&　宮城県のセル &"、"&東京都のセル
各都道府県の行番号が
北海道「１」
宮城県「４」
東京都「１３」
ならば、
range("").value = range("A1").value&"、"&range("A4").value&"、"&range("A13").value

というようになればいいのですが、
オートフィルタ後に行数をカウントし、次のようなコードにすると、

range("").value = range("A1").value&"、"&range("A2").value&"、"&range("A3").value

１９９９年　北海道、青森県、岩手県

となりオートフィルタ前の値が返されてしまいます。
このセルをどのように指定したらいいのかわかりません。

もしこれができないのであれば
各列に一つずつ（一つのセルに一つの都道府県）入れていく方法でも構いません。

１９９９年　北海道　宮城県　東京都　

というような感じです。

よろしくお願いします。

回答No.2

mitarashi · ベストアンサー

オートフィルタで抽出された行だけ対象にして処理する例です。ご参考まで。
連想配列向けの課題かもしれません。興味を持たれたら、VBA dictionaryでお調べ下さい。
Sub test()
Debug.Print funcTest("１９９９年")
End Sub

Private Function funcTest(targetYear As String) As String
Dim targetRange As Range
Dim i As Long
Dim prefNames As String

With ActiveSheet
Set targetRange = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3)
End With
With targetRange
.AutoFilter Field:=1, Criteria1:=targetYear
For i = 2 To .Rows.Count
If .Cells(i, 1).EntireRow.Hidden = False Then
If prefNames = "" Then
prefNames = .Cells(i, 2).Value
Else
prefNames = prefNames & "," & .Cells(i, 2).Value
End If
End If
Next
.AutoFilter
End With
funcTest = prefNames
End Function

参考URL：

http://okwave.jp/qa/q5694462.html

お礼

遅れて申し訳ございません。
ご回答ありがとうございます。

まだ初心者なので、これはちょっとわかりませんでした・・・
また勉強してみます。
しかしmitarashiさんのコードで「resize」という関数があることを
知り、それと「currentregion」を組み合わせることでうまくすることができました。

回答No.1

soixante

元データがどのようになっているのかわかりませんが、わたしでしたら以下のようにしてみます。
オートフィルタは使ってません。

・データの入ってるシートがSheet1、まとめるシートがSheet2 とします。
・Sheet1　の　Ａ列が発生年、　Ｂ列が都道府県名　とします。
・Sheet2　の　Ａ列が発生年、　Ｂ列以降、右に都道府県名としています。（ひとつづつデータを入れる）

元データを上から順に、ひとつづつ、まとめシートの該当年のところにデータを飛ばしていきます。

Sub EarthquakeData()

Dim r As Integer
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Nen As Integer, Ken As String
Dim NenRow As Integer, NenCol As Integer

Set Ws1 = Worksheets(1)
Set Ws2 = Worksheets(2)

r = 2
Do While Ws1.Cells(r, 1) <> ""
　　　 Nen = Ws1.Cells(r, 1).Value
　　　 Ken = Ws1.Cells(r, 2).Value
　　　 NenRow = Application.WorksheetFunction.Match(Nen, Ws2.Columns(1), 0)
　　　 NenCol = Ws2.Cells(NenRow, Columns.Count).End(xlToLeft).Column + 1
　　　 Ws2.Cells(NenRow, NenCol).Value = Ken
　　　 r = r + 1
Loop

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

どうしても県名をひとつのセルに入れたいなら、この振り分け後のものを処理していただくだけです。

お礼

遅れて申し訳ございません。
ご回答ありがとうございます。
説明不足でしたが、
横方向に年度、縦方向に都道府県で、
それぞれの年度に何件発生したかというような形態でした。
たぶん、このやり方であればうまくいきそうですが、
データを組直さなければならないので・・・
今回は「currentregion」と「resize」を使って
うまくすることができました。
まだ初心者なのでいろいろな人のコードを見るのは興味深いですね。
Ws2.Cells(NenRow, Columns.Count).End(xlToLeft).Columnというところとか、
Match(Nen, Ws2.Columns(1), 0)とかどういう風に動くのか考えるだけで
勉強になりました。