個別の並び替え条件のマクロ（or関数）について質問です。・以下画像をご覧ください・やりたい事は、左の表を右の表へ並び換える事です・右の青色とオレンジの契約が上に来るように並び換えたいです・以下の条件のように並び換える事ができるマクロや関数を教えてください・宜しくお願いします【条件】以下4条件を満たす（orではなくandです）1同じ人（人は名前と生年月日、法人は法人名と住所※法人名だけでも良い）を 並べる２契約状態が、AとBが混ざっているものが欲しい３契約状態が、AとAや、BとBはいらいなです４複数の契約がある人が欲しい⇒２つ以上。１つだけは不要

少しバブルソートに似ているかも、





Sub Macro()

Dim myOrder As String, ky As Variant, dic As Object, buf As String

Dim i As Long, j As Long, ap As Application

Set ap = Application

Set dic = CreateObject(\u0026quot;Scripting.Dictionary\u0026quot;)

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

dic(Cells(i, 1).Value) = \u0026quot;\u0026quot;

Next

ky = dic.keys

For i = 0 To UBound(ky)

If (ap.CountIfs(Columns(1), ky(i), Columns(6), \u0026quot;A\u0026quot;) = 0) Or (ap.CountIfs(Columns(1), ky(i), Columns(6), \u0026quot;B\u0026quot;) = 0) Then

buf = ky(i)

For j = i To UBound(ky) - 1

ky(j) = ky(j + 1)

Next

ky(UBound(ky)) = buf

End If

Next

myOrder = Join(ky, \u0026quot;,\u0026quot;)

With ActiveSheet.Sort

.SortFields.Clear

.SortFields.Add2 Key:=Range(\u0026quot;A2\u0026quot;), CustomOrder:=\u0026quot;\u0026quot; \u0026amp; myOrder \u0026amp; \u0026quot;\u0026quot;

.SetRange Range(\u0026quot;A1\u0026quot;).CurrentRegion

.Header = xlYes

.Apply

End With

End Sub