1回目転記して重複した2回目、空白だったら転記します。
なのでたとえば和歌山の5年度の二つともに入力があったら、2つ目は無視する仕様ですが。
Sub Sample()
Dim i As Long, j As Long
Dim area As Range, start As Range, buf As Range, fnd As Range
Dim dic As Dictionary
Set dic = New Dictionary
'元の表範囲
Set area = Range(\u0026quot;A1:L9\u0026quot;)
'新しい表範囲の左上セル
Set start = Range(\u0026quot;A12\u0026quot;)
'重複しない県名を転記
For i = area(1).Row + 1 To area.Rows.Count
Set buf = Cells(i, \u0026quot;B\u0026quot;)
Set dic(buf.Value) = buf.Value
Next i
start.Offset(1, 1).Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.Keys)
'項目転記
For i = area(1).Row + 1 To area.Rows.Count
Set buf = Cells(i, \u0026quot;B\u0026quot;)
Set fnd = start.Offset(1, 1).Resize(dic.Count).Find(buf.Value, LookAt:=xlWhole)
For j = 1 To 10 '項目列数
If fnd.Offset(, j).Value = \u0026quot;\u0026quot; Then _
fnd.Offset(, j).Value = buf.Offset(, j).Value
Next j
Next i
Set dic = Nothing
End Sub
