58

view

いろいろな方法が考えられると思いますが、まあひとつの例として

Public Function Sample(rngBranches As Range, rngBranchList As Range)
Dim intTerms As Variant, strBranches As Variant
Dim R As Range
Dim strBefore As String, intC As Integer
Dim X As Integer, Y As Integer
X = rngBranches.Columns.Count 6
Y = rngBranchList.Columns.Count - 1
ReDim intTerms(X, Y)
For Each R In rngBranches
If R = strBefore Then
intC = intC + 1
Else
If strBefore <> "" Then
' On Error Resume Next
Y = Application.WorksheetFunction.Match(strBefore, rngBranchList, 0) - 1
X = (intC + 1) 6
intTerms(X, Y) = intTerms(X, Y) + 1
End If
intC = 0
strBefore = R
End If
Next
Sample = intTerms
End Function

こんなユーザー関数はどうでしょうか。
やってることは単純で、適当な大きさの２次元配列をつくり、ループをまわして前のセルと内容が変わったら配列の値を＋１していってるだけです。

たとえば、Sheet1のA1:CJ3000 に元データの表があるとします。（１行目とＡ列は見出しなので、純粋なデータは B2:CJ3000）
そして、別のシートの B1:L1 に都道府県名が入っていて、B2:L16 に集計結果を入れたいとします。
その場合、上で示したユーザー関数が定義してあれば、別シートの B2:L16 に
=Sample(Sheet1!B2:CJ3000,Sheet2!B1:L1)
という数式を配列数式として入力します。
一つ目の引数が元データの範囲、二つ目の引数が集計する都道府県名の見出しの範囲です。

--------注--------
よく分からなかったのですが一番上の行に集計すべきなのは６ヶ月未満で良かったでしょうか。
６ヶ月以下なのなら
X = (intC + 1) 6
を
X = intC 6
に変えてください。
あと、ぜんぜんエラー処理してません。リストにない都道府県名が出てきたときの処理とかは適当に工夫して付け足してください。

補足

よく考えたら、これじゃだめだ・・・。
元データの最後の列を空白にしておけば上記のままでうまくいくはず。
そうでないとたとえばＡ氏の2007/6/1 の勤務地と、Bさんの2000/4/1が同じだと、うまくいかないです。
まあサンプルですんで多目にみて、必要なら適当に改良してくださいませ。