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

Question

こんにちは。
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

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

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

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

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

というような感じです。

よろしくお願いします。

mitarashi · Accepted Answer

オートフィルタで抽出された行だけ対象にして処理する例です。ご参考まで。
連想配列向けの課題かもしれません。興味を持たれたら、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

soixante · Answer

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

・データの入ってるシートが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

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

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

オートフィルタで抽出された行だけ対象にして処理する例です。

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

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング