0 / 0 / 0
Регистрация: 23.06.2017
Сообщений: 3
1

Два двумерных массива

23.06.2017, 10:28. Показов 1479. Ответов 6

Author24 — интернет-сервис помощи студентам
Доброго времени суток уважаемые мастера кода.
Написал код который выдает результаты очень медленно (1 за в секунду, а у меня их 30000). Решение через функции рабочего листа тоже работают крайне медленно.
Задача:пролетает самолет, нужны все координаты спутника которые на определенном расстоянии от маршрута самолета и записывал их в столбцы 7 и 8 без пропуска строк. В идеале нужно использовать разность квадратов взятых под корень, но в моей формуле использовал сумму отклонений по долготе и широте - "квадрат" в целях экономии ресурсов в ущерб точности, но тщетно.
Решением для оптимизации кажется использование массива, но видимо я что-то путаю в синтаксисе.

Столбцы обозначают следующее:
2й: Широта спутниковых данных
3й: Долгота спутниковых данных

5й: Широта самолетных данных
6й: Долгота самолетных данных

Вот мой медленный рабочий вариант без использования массива:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub sortdistance()
 
           Application.Calculation = xlCalculationManual
           Application.ScreenUpdating = False
           Application.EnableEvents = False
 
 
Dim i As Integer
Dim j As Integer
Dim x As Integer
 
LastSatellite = Cells(Rows.Count, 2).End(xlUp).Row
LastPlane = Cells(Rows.Count, 5).End(xlUp).Row
dopusk = InputBox("Enter the limit:")
 
x = 2
For i = 2 To LastSatellite
 
    For j = 2 To LastPlane
   
        If (Abs(Cells(i, 2) - Cells(j, 5))) < dopusk Then
            If (Abs(Cells(i, 3) - Cells(j, 6))) < dopusk Then
               Cells(x, 7) = Cells(i, 2)
               Cells(x, 8) = Cells(i, 3)
               x = x + 1
               GoTo NextRow
            End If
        End If
    Next j
NextRow:
Next i
 
           Application.Calculation = xlCalculationAutomatic
           Application.ScreenUpdating = True
           Application.EnableEvents = True
 
End Sub
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
23.06.2017, 10:28
Ответы с готовыми решениями:

Заданы два двумерных массива K и L размером 3*3. Сформировать из них массив Q
Заданы два двумерных массива K и L размером 3*3. Сформировать из них массив Q размером 3*6,...

Ввести два двумерных массива (3*3)
Ввести два двумерных массива (3*3). Провести транспонирование первого массива, затем поэлементное...

Сложить два двумерных массива
Как сложить два двумерных массива???Вот ф-ии для ввода двух массивов и геттеры для них. Надо ф-ию...

Объединить два двумерных массива размерностью N*N в один, так, чтобы все строки первого массива стали чётными
Объединить два двумерных массива размерностью N*N в один, так, чтобы все строки первого массива...

6
185 / 183 / 31
Регистрация: 11.10.2016
Сообщений: 599
23.06.2017, 14:12 2
было бы неплохо описать переменные LastSatellite, LastPlane, и dopusk. По умолчанию они типа Variant, а с ними VB медленно работает. Вместо GoTo NextRow можно также написать Exit For, заодно и метку убрать можно.
Возможно, разбирающиеся в Экселе еще что-то могут посоветовать. Если цикл с большим количеством значений, то дабы не грузить систему, можно после Next j "впихнуть" DoEvents
1
3897 / 2302 / 776
Регистрация: 02.11.2012
Сообщений: 6,119
23.06.2017, 15:21 3
ускорить можно загнав данные в массив и работать в коде с массивом.
0
185 / 183 / 31
Регистрация: 11.10.2016
Сообщений: 599
23.06.2017, 15:29 4
Цитата Сообщение от Vlad999 Посмотреть сообщение
ускорить можно загнав данные в массив и работать в коде с массивом.
дык, ТС так и написал
Цитата Сообщение от chelxxx Посмотреть сообщение
Решением для оптимизации кажется использование массива
мне тоже кажется, к ячейкам лучше не обращаться напрямую, а сначала скинуть значения в цикл, обработать, потом скопировать обратно
0
3897 / 2302 / 776
Регистрация: 02.11.2012
Сообщений: 6,119
23.06.2017, 16:30 5
Лучший ответ Сообщение было отмечено chelxxx как решение

Решение

проверяйте.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub sortdistance()
 
           Application.Calculation = xlCalculationManual
           Application.ScreenUpdating = False
           Application.EnableEvents = False
 
 
Dim i As Integer
Dim j As Integer
Dim x As Integer
 
LastSatellite = Range("B2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Value
LastPlane = Range("E2:F" & Cells(Rows.Count, 5).End(xlUp).Row).Value
dopusk = InputBox("Enter the limit:")
 
x = 2
For i = 2 To UBound(LastSatellite)
     For j = 2 To UBound(LastPlane)
        If (Abs(LastSatellite(i, 1) - LastPlane(j, 1))) < dopusk Then
            If (Abs(LastSatellite(i, 2) - LastPlane(j, 2))) < dopusk Then
               Cells(x, 7) = LastSatellite(i, 1)
               Cells(x, 8) = LastPlane(i, 1)
               x = x + 1
               Exit For
            End If
        End If
    Next j
Next i
 
           Application.Calculation = xlCalculationAutomatic
           Application.ScreenUpdating = True
           Application.EnableEvents = True
 
End Sub
1
0 / 0 / 0
Регистрация: 23.06.2017
Сообщений: 3
24.06.2017, 15:49  [ТС] 6
Да, я пробовал объявлять всё. Результат был схожий.

Добавлено через 20 часов 27 минут
Большое спасибо, работает. 20000х2 + 30000х2 массив просчитывает за пару минут. Буду смотреть как быстро считает квадратичным отклонением.
А пока вот мой рабочий код на данный момент с отклонениями в рамках "квадрата" вокруг точки:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub sortdistance()
 
         
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim dopusk As Single
 
LastSatellite = Range("B2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Value
LastPlane = Range("E2:F" & Cells(Rows.Count, 5).End(xlUp).Row).Value
 
dopusk = InputBox("Enter the limit:")
 
x = 2
For i = 1 To UBound(LastSatellite)
     For j = 1 To UBound(LastPlane)
        If (Abs(LastSatellite(i, 1) - LastPlane(j, 1))) < dopusk Then
            If (Abs(LastSatellite(i, 2) - LastPlane(j, 2))) < dopusk Then
               Cells(x, 7) = LastSatellite(i, 1)
               Cells(x, 8) = LastSatellite(i, 2)
               x = x + 1
               Exit For
            End If
        End If
    Next j
Next i
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 
        
End Sub
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
24.06.2017, 19:27 7
Думаю есть смысл Abs(LastSatellite(i, 1) и Abs(LastSatellite(i, 2) обсчитывать не на каждое изменение j, а только на каждое изменение i
0
24.06.2017, 19:27
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
24.06.2017, 19:27
Помогаю со студенческими работами здесь

Как объединить два двумерных массива?
есть массивы А и B как их зделать в C, проста смотрел про одномерные массивы там все както проста...

Есть два двумерных целочисленных динамических массива
Здравствуйте, хочу реализовать задачу, сравнить два двумерных целочисленных динамических массива,...

Поэлементно просуммировать два динамических двумерных массива
Здравствуйте, у меня такое задание: Написать программу, которая поэлементно суммирует два...

Как проверить на равенство два двумерных массива?
вот код, надо узнать был ли такой элемент в массиве или нет srand(time(0)); bool alreadyThere...

Два двумерных массива объединить в один двумерный
Даны два двумерных массива LL; PER; Нужно их объединить в один Mas чтобы порядок чисел...

Даны два двумерных массива целых чисел А[5][5], В[5][5].
Определить, в котором из них наименьшая сумма элементов главной диагонали, если такой массив один....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru