Sub Кластеризация

Dim XX(1..100),

        YY(1..100),

//столбцы таблицы с координатами точек 

          X(1..100), 

          Y(1..100),

//рабочие массивы содержащие координаты центров масс текущих кластеров

          R(1..100,1..100),

//массив расстояний между центрами масс

        NT(1..100,1..100),

//номера точек вошедших в кластеры

      NKL(1..100),

//номер кластера для простановки в исходную таблицу

         M(1..100);

//мощность кластера

 Dim 
 N, I, J, IMIN, JMIN,  NK, RMIN,
RT;

       //не знаю как сослаться на
ячейку, вдобавок еще и на другой лист, так что:

      N=100;

 //цикл заполнения исходного
массива (как для Pascal):

          For I=1 to N

                  XX(I)=REN(1,200);

                  YY(I)=REN(1,200);

                    X(I)=XX(I);

                    Y(I)=YY(I);

                  M(I)=1;

                  NT(I,1)=I;

                  NK=N;

                  NT(J)=I;

            Next;

 //Цикл кластеризации:

             While NK>7 

                For I=1 to NK-1 

                   For J=I+1 to NK 

                      R(I,J)=sqrt((X(I)-X(J))*(X(I)-X(J))+(Y(I)-Y(J))*(Y(I)-Y(J)));

               
   Next;

                Next;    

                   RMIN=R(1,2); IMIN=1; JMIN=2;

                     For I=1 to NK-1 

                        For J=I+1 to NK 

                              If R(I,J)>=RMIN
then CONTINUE;

                                    RMIN=R(I,J);

                                     IMIN=I;

                                     JMIN=J;

                        Next;

                     Next;

                     X(IMIN)=(X(IMIN)+X(JMIN))/2;

                     Y(IMIN)=(Y(IMIN)+Y(JMIN))/2;

                   M(IMIN)=M(IMIN)+M(JMIN);

              For J=1 to M(JMIN) do

                 NT(IMIN,M(IMIN)+J)=NT(JMIN,J);

              Next;

              If JMIN< NK-1 then

          For I= JMIN to NK-2 do

               X(I)=X(I+1);

               Y(I)=Y(I+1);

              M(I)=M(I+1);

                 For J=1 to N do

                       NK(I,J)=NT(I+1,J)

                Next;

          Next;

     NK=NK-1;

  Wend;

 

For I=1 to NK do

For J= 1 to M(I) do

NKL(  NK(I,J))=I;

Next; 

Next;

End Sub