Sub M_ExceL()
Dim A As Variant
lstr = Cells(Rows.Count, 1).End(3).Row + 1
Range("d2:d" & lstr).ClearContents
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:A" & lstr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
A = Range("a1:a" & lstr).Value
c = 2
For i = 1 To UBound(A) - 2
Left_a = i + 1
right_a = UBound(A) - 1
If i <> 1 And A(i, 1) = A((UBound(A) + 1) - i, 1) Or i = 1 Then GoTo continue
Do While Left_a < right_a
If A(Left_a, 1) + A(right_a, 1) = -A(i, 1) Then
Cells(c, 4) = Str(A(i, 1)) + " , " + Str(A(Left_a, 1)) + " , " _
+ Str(A(right_a, 1))
Left_a = Left_a + 1
right_a = right_a - 1
Do While A(Left_a, 1) = A(Left_a - 1, 1) And Left_a < right_a
Left_a = Left_a + 1
Loop
Do While A(right_a, 1) = A(right_a + 1, 1) And Left_a < right_a
right_a = right_a - 1
Loop
c = c + 1
ElseIf A(Left_a, 1) + A(right_a, 1) < -A(i, 1) Then
Left_a = Left_a + 1
Else
right_a = right_a - 1
End If
Loop
continue:
Next
End Sub
کامنت