1

Доброе время суток. Есть задача в Excel. Нужно сравнить два столбца и подобрать для второго столбца наиболее близкое значение из первого.

Макрос который использую
1 Ст; 2 Ст ; результат
1200; 1900; 1300
1300; 1200; 1200
2800; 2680;
840 ; 841 ; 840
830 ; 720 ;
750 ;
все время разные данные. Желательно макрос.
Применял макрос, но он не корректно подбирает значения.

Sub Raspredlitel()
Dim arrEt, arrMetka, arrMetka2, arrIncome  
Dim i%, iGlob%, j%, eps&, mJ%, mI%

arrEt = Range([D4], [D10000].End(xlUp)).Value
arrIncome = Range([K4], [K10000].End(xlUp)).Value

ReDim arrMetka(1 To UBound(arrEt))
ReDim arrMetka2(1 To UBound(arrIncome))

For iGlob = 1 To UBound(arrIncome, 1)
    eps = 9 ^ 9
    mJ = 1
    mI = 1
    For i = 1 To UBound(arrIncome, 1)
        If IsEmpty(arrMetka2(i)) Then
            For j = 1 To UBound(arrEt)
                If Abs(arrIncome(i, 1) - arrEt(j, 1)) < eps And IsEmpty(arrMetka(j)) Then
                    mJ = j
                    mI = i
                    eps = Abs(arrIncome(i, 1) - arrEt(j, 1))
                End If
            Next j
        End If
    Next i
    arrMetka(mJ) = 1
    arrMetka2(mI) = 1
    [M3].Offset(mI) = arrEt(mJ, 1)
Next iGlob
End Sub
1
  • Как некорректно, получается указанный в вопросе результат? Попробуйте для начала при iGlob == 4 просто все arrIncome с IsEmpty(arrMetka2(i)) скопировать в какой-нибудь столбец, а также аналогично для arrEt 4 сен 2013 в 17:57

1 ответ 1

1

Не разбирался в Вашем коде. Быстрее свой написать :)

Option Explicit

Sub Raspredlitel()
Dim ArrMetka1, ArrMetka2, ArrTemp
Dim lRws As Long
Dim i As Long, j As Long
    With Worksheets("Лист1")
        lRws = .Cells(Rows.Count, "D").End(xlUp).Row + 1
        ArrMetka1 = .Range("D4:D" & lRws).Value ' значения в массив

        lRws = .Cells(Rows.Count, "K").End(xlUp).Row + 1
        ArrMetka2 = .Range("K4:K" & lRws).Value ' значения в массив
        ' задаем размерность массива
        ReDim ArrTemp(1 To UBound(ArrMetka2, 1) + 1, 1 To 1)

        For i = 1 To UBound(ArrMetka2, 1)
            ' запоминаем разность i-значения второго диапазона и первого значения первого диапазона
            ArrTemp(i + 1, 1) = Abs(ArrMetka2(i, 1) - ArrMetka1(1, 1))
            ArrTemp(i, 1) = ArrMetka1(1, 1) ' запоминаем первое значение первого диапазона
            For j = 1 To UBound(ArrMetka1, 1)
                ' если разность меньше записанной, запоминаем меньшее
                If Abs(ArrMetka2(i, 1) - ArrMetka1(j, 1)) < ArrTemp(i + 1, 1) Then
                    ArrTemp(i + 1, 1) = Abs(ArrMetka2(i, 1) - ArrMetka1(j, 1))
                    ArrTemp(i, 1) = ArrMetka1(j, 1)
                End If
            Next j
        Next i

        ' выгружаем массив на лист
        .Range("M4").Resize(UBound(ArrMetka2, 1), 1).Value = ArrTemp
    End With
End Sub
2
  • Применил скрипт (код).Результат получил тот же. А именно: есть значение например 2629 а подбирает 2851, а есть 2122 и есть например значение 839 он выбирает 840 и для него есть значение 749. И еще не могу понять как сделать чтоб те значения которые подходят он подставлял в М4 но при этом он его убирал с 1 столбца.
    – kadekin77
    6 сен 2013 в 1:59
  • Ваше задание: подобрать к значению второго столбца наиболее близкое значение из первого столбца. В первом сообщении ни слова о том, что число не должно быть больше (или меньше). Т.е выбираем число, "расстояние" от которого до образца меньше. 2629-2851=-22; 2629-2122=507 222 меньше, чем 507. Выбираем 2851. 839-840=1; 749-839=90 Что Вас не устроило? Сомневась, что Ваш вопрос правильно сформулирован. Почему в Вашем примере из первого сообщения возле значений 2800 и 720 нет результата? 6 сен 2013 в 16:30

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими условиями использования и подтверждаете, что прочитали и поняли наши политику конфиденциальности и нормы поведения.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.