The scale of the problem is still beyond imagination and unable to handle:

In[6]:= Subsets[pk,{2,20}]//Length

During evaluation of In[6]:= Subsets::toomany: The number of subsets (3079913176815553421320) indicated by Subsets[{{2,3,1},{4,5,1},{6,3,2},{6,7,1},{10,11,1},{12,13,1},{16,17,1},{18,3,3},{18,19,1},{20,5,2},<<97>>},{2,20}] is too large; it must be a machine integer.

Out[6]= 2

The scale of the problem is still beyond imagination and unable to handle:

In[6]:= Subsets[pk,{2,20}]//Length

During evaluation of In[6]:= Subsets::toomany: The number of subsets (3079913176815553421320) indicated by Subsets[{{2,3,1},{4,5,1},{6,3,2},{6,7,1},{10,11,1},{12,13,1},{16,17,1},{18,3,3},{18,19,1},{20,5,2},<<97>>},{2,20}] is too large; it must be a machine integer.

Out[6]= 2

My actual data is something as follows:

n = 500;
lst={ { 2, 3, 1 }, { 6, 3, 2 }, { 18, 3, 3 }, { 54, 3, 4 }, { 162, 3,
5 }, { 486, 3, 6 }, { 4, 5, 1 }, { 20, 5, 2 }, { 100, 5, 3 }, { 6, 7,
1 },
  { 42, 7, 2 }, { 294, 7, 3 }, { 10, 11, 1 }, { 110, 11, 2 }, { 12,
13, 1 }, { 156, 13, 2 }, { 16, 17, 1 }, { 272, 17, 2 }, { 18, 19, 1 },
  { 342, 19, 2 }, { 22, 23, 1 }, { 28, 29, 1 }, { 30, 31, 1 }, { 36,
37, 1 }, { 40, 41, 1 }, { 42, 43, 1 }, { 46, 47, 1 }, { 52, 53, 1 },
  { 58, 59, 1 }, { 60, 61, 1 }, { 66, 67, 1 }, { 70, 71, 1 }, { 72,
73, 1 }, { 78, 79, 1 }, { 82, 83, 1 }, { 88, 89, 1 }, { 96, 97, 1 },
  { 100, 101, 1 }, { 102, 103, 1 }, { 106, 107, 1 }, { 108, 109, 1 },
{ 112, 113, 1 }, { 126, 127, 1 }, { 130, 131, 1 }, { 136, 137, 1 },
  { 138, 139, 1 }, { 148, 149, 1 }, { 150, 151, 1 }, { 156, 157, 1 },
{ 162, 163, 1 }, { 166, 167, 1 }, { 172, 173, 1 }, { 178, 179, 1 },
  { 180, 181, 1 }, { 190, 191, 1 }, { 192, 193, 1 }, { 196, 197, 1 },
{ 198, 199, 1 }, { 210, 211, 1 }, { 222, 223, 1 }, { 226, 227, 1 },
  { 228, 229, 1 }, { 232, 233, 1 }, { 238, 239, 1 }, { 240, 241, 1 },
{ 250, 251, 1 }, { 256, 257, 1 }, { 262, 263, 1 }, { 268, 269, 1 },
  { 270, 271, 1 }, { 276, 277, 1 }, { 280, 281, 1 }, { 282, 283, 1 },
{ 292, 293, 1 }, { 306, 307, 1 }, { 310, 311, 1 }, { 312, 313, 1 },
  { 316, 317, 1 }, { 330, 331, 1 }, { 336, 337, 1 }, { 346, 347, 1 },
{ 348, 349, 1 }, { 352, 353, 1 }, { 358, 359, 1 }, { 366, 367, 1 },
  { 372, 373, 1 }, { 378, 379, 1 }, { 382, 383, 1 }, { 388, 389, 1 },
{ 396, 397, 1 }, { 400, 401, 1 }, { 408, 409, 1 }, { 418, 419, 1 },
  { 420, 421, 1 }, { 430, 431, 1 }, { 432, 433, 1 }, { 438, 439, 1 },
{ 442, 443, 1 }, { 448, 449, 1 }, { 456, 457, 1 }, { 460, 461, 1 },
  { 462, 463, 1 }, { 466, 467, 1 }, { 478, 479, 1 }, { 486, 487, 1 },
{ 490, 491, 1 }, { 498, 499, 1 } };
pk = SortBy[lst,First]

count=0;
subsets[subset_,total_,list_]:=(
  Print[count++];
  If[total== target ,Sow[Partition[Flatten[subset],3]]];
  If[list!={}&&total+list[[1,1]]<= target,
    subsets[subset,total,Rest[list]];
    subsets[{subset,list[[1]]},total+list[[1,1]],Rest[list]]
  ]);
Reap[subsets[{},0, lst]][[2,1]]

According to my test, the above code has been running for a long time without ending or seeing any improvement in efficiency. So I terminated it.

I didn't analyze your algorithm, but I don't think it finds all of the possibilities. For example, your output is missing {{2, 3, 1}, {4, 5, 1}, {6, 3, 2}, {10, 11, 1}}.

As I've said, the following condition must also be met:

All the second elements in a specific sub-list should be different.

In the above result shown by you, 3 appears twice in the 2nd positions of the sub-lists, so this shouldn't be a desired solution in my case, and I removed it from the results:

lst=Select[ sub, (#[[All,1]]//Total)==n && (#[[All,2]]//Length)==(Union[ #[[All,2]] ]//Length) &  ]

I came up with an algorithm that is faster and that finds more results. It uses IntegerPartitions instead of Subsets. However it typically takes over a minute when length of pk is 30.

Does your approach also rely on dynamic programming (DP) technology? I wonder if you can show me the algorithm?

Here's another algorithm I've noticed for this problem:

(* 2.2 The practical code
We here present a light code for the algorithm, which is written in language “Mathematica”
because of its easily available and amicable windows. *)

BeginPackage["DiscreteMath‘SubsetSum‘"]
SubsetSum::usage = "Find all solutions for subset sum problem."
Begin["‘Private‘"]
SubsetSum[t_, W_List]:=
Module[{T,K,A,len,F},
T={t};
For[i=1,i<=Length[W],i++,B=T-W[[i]];T=Join[T,B]];
K=Flatten[Position[T,0]];
If[Length[K]>0,
For[i=1,i<=Length[K],i++,
A=IntegerDigits[2(K[[i]]-1),2];
len=Length[A];F={};
For[j=1,j<=len,j++,If[A[[j]]==1,F=Append[F,W[[len-j]]]]];
Print[F]
],
Print["Fail"]
]
]
End[]
EndPackage[]

How long will your pk be? Do you need to find absolutely all solutions?

I'm solving a problem related to number theory and group theory, and of course I want the algorithm to deal with extremely long lists as efficiently as possible, so that I can make a larger comparison database for others to study and use.