How to speed up integers finding function?

ClearAll[pairS]

pairS[n_] := SortBy[First] @
  Apply[Join] @
   KeyValueMap[Function[{k, v},
      Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]] @
    GroupBy[Sort@*IntegerDigits] @
     (999 + 9 Range[10^(n - 1)])

Examples:

 pairS[4] // AbsoluteTiming // First

0.0445052

pairS[5] // AbsoluteTiming // First

1.19877

Multicolumn[pairS[4], 5]

Length @ pairS[5] 

673

pairS[5] // Short[#, 7] &

An aside: A slower graph-based method: get the edge list of a graph where the numbers $a$ and $b$ are connected if $a$, $b$ and $a+b$ have the same integer digits.

relation = Sort[IntegerDigits @ #] == Sort[IntegerDigits @ #2] == 
    Sort[IntegerDigits[# + #2]] &;

relationgraph = RelationGraph[relation, 999 + 9 Range[10^(4 - 1)]];

edges = EdgeList @ relationgraph;
 
List @@@ edges == pairS[4]

True

Subgraph[relationgraph, VertexList[edges], 
 GraphLayout -> "MultipartiteEmbedding", 
 GraphStyle -> "VintageDiagram", ImageSize -> Large]

Approach 1, more concise

Clear[search];
search[n_] := 
   Join @@ Table[With[{s = Subsets[a, {2}]}, 
     Pick[s, Boole@MemberQ[a, Total@#] & /@ s, 1]], 
      {a, GatherBy[Select[Range[10^(n - 1), 10^n - 1], Divisible[#, 9] &], 
        Sort@*IntegerDigits]}];

search[4] // Length // AbsoluteTiming
search[5] // Length // AbsoluteTiming
search[6] // Length // AbsoluteTiming

{0.0210189, 25}
{0.212638, 648}
{9.23615, 17338}

Approach 2, more efficient

Clear[cf]
cf = Compile[{{n, _Integer}, {A, _Integer, 2}},
   Module[{nums, ni, nj, B = Internal`Bag[Most@{0}]},
    Do[
     nums = Permutations[a]. 10^Range[n - 1, 0, -1];
     Do[
      ni = nums[[i]];
      nj = nums[[j]];
      If[ni + nj > 10^n || ni < 10^(n - 1), Break[]];
      Do[If[ni + nj == k, Internal`StuffBag[B, {ni, nj, k}, 1]; Break[]]
       , {k, nums}]
      , {i, Length@nums}, {j, i + 1, Length@nums}]
     , {a, A}];
    Internal`BagPart[B, All]
    ], CompilationTarget -> "C", RuntimeOptions -> "Speed"
   ];

n = 4;
AbsoluteTiming[
 digits = Select[# - Range[n] & /@ Subsets[Range[9 + n], {n}], Divisible[Total@#, 9] &];
 Length[ans = Partition[cf[n, digits], 3]]
 ]

For n=4

{0.0014472, 25}

For n=5,

{0.0094707, 648}

For n=6,

{0.802517, 17338}

Compare with kglr's answer

ClearAll[pairS]
pairS[n_] := 
  Apply[Join]@ KeyValueMap[Function[{k, v}, 
   Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]]@
    GroupBy[Sort@*IntegerDigits]@(10^(n - 1) - 1 + 9 Range[10^(n - 1)])

pairS[4] // Length // AbsoluteTiming
pairS[5] // Length // AbsoluteTiming
pairS[6] // Length // AbsoluteTiming

{0.0362128, 25}
{0.945485, 648}
{40.879, 17338}

But it took ages to give the output.

It took ~170 seconds on my computer; with ParallelTable it took ~97 seconds.

I assume two-times speed-up is not good enough, but it was very easy to get it.