Нужно получить результат, не используя в коде Select

@Igor_Tr · Регистрация: 17.01.2010

Студворк — интернет-сервис помощи студентам

Добрый день! Подскажите, пожалуйста, как выйти из подобной ситуации. Нужно получить результат, не используя
.Select

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
dim funFindCell as range ' (здесь! только ячейка)
 dim fa%, fb%, fc%, fd as Integer
'было:
    fa = funFindCell.Value
    fb = funFindCell.Offset(0, 1).Value
    fc = funFindCell.Offset(0, 2).Value
    fd = funFindCell.Offset(0, 3).Value
'Если у меня в строке funFindCell.Row сплошные _
обьединенные ячейки - факт, от меня не зависящий - работа
'приведенного кода не корректна. 
'Изменил код на: 
    funFindCell.Select
    fa = funFindCell.Value
    ActiveCell.Offset(0, 1).Select
    fb = ActiveCell.Value
    ActiveCell.Offset(0, 1).Select
    fc = ActiveCell.Value
    ActiveCell.Offset(0, 1).Select
    fd = ActiveCell.Value
'Работает, но нужно без ".Select"

@Апострофф · 10.12.2012, 14:10

Visual Basic
1
2
3
4
5
6
7
    fa = funFindCell.Value
    Set funFindCell = funFindCell.Offset(0, 1)
    fb = funFindCell.Value
    Set funFindCell = rn.Offset(0, 1)
    fc = funFindCell.Value
    Set funFindCell = funFindCell.Offset(0, 1)
    fd = funFindCell.Value

@Igor_Tr · 10.12.2012, 14:43 **[ТС]**

Не совсем. Прогнал и получил в результате fa=1 (правильно!), fb=2 (должно =2), fc=2 (должно =3), fd=3 (должно =4). Уточню, для чего это нужно. Получена таблица для анализа. Необходимо найти первую (или все) строку нумерации столбцов, а стоблцы содержат обьединенные ячейки.

Добавлено через 7 минут
Если через Select - тогда работает, но увеличивается время, не смотря на применение Application.ScreenUpdating = False.

@Апострофф · 10.12.2012, 14:44

4-я строка -

Visual Basic
1
Set funFindCell = funFindCell.Offset(0, 1)

недосмотрел

или

Visual Basic
1
2
3
4
    fa = funFindCell.Value
    fb = funFindCell.Offset(0, 1).Value
    fc = funFindCell.Offset(0, 1).Offset(0, 1).Value
    fd = funFindCell.Offset(0, 1).Offset(0, 1).Offset(0, 1).Value

@Igor_Tr · 10.12.2012, 16:58 **[ТС]**

Спасибо!!! Огромное! И такой вариант работает.

Сообщение от Апострофф

Visual Basic
1
Set funFindCell = funFindCell.Offset(0, 1)

И время вернулось в "НОРМУ"! Кстати, благодаря, в т.ч. Вашим, подсказкам, я за каждую строку и секунду - как питбуль за кость...

Добавлено через 1 час 47 минут
to Апострофф. При использовании Вашего первого (исправленного) варианта, в теле цикла ( в полном варианте листинга) Do.......Loop пришлось переопределять range. При использовании окончательного, Вашего, естественно,
ушла в мусор куча ненужного и все работает! Вы у меня, точно, разовьете какую-то паранойю "сжимательства"!!!

@Апострофф · 10.12.2012, 17:57

Сообщение от Igor_Tr

я за каждую строку и секунду - как питбуль за кость...

Если за приоритет взять секунды, то -

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
With funFindCell
  fa = .Value
  With .Offset(0, 1)
    fb = .Value
    With .Offset(0, 1)
      fc = .Value
      With .Offset(0, 1)
        fd = .Value
      End With
    End With
  End With
End With

По идее данный код должен работать быстрее, чем с

Visual Basic
1
funFindCell.Offset(0, 1).Offset(0, 1).Offset(0, 1)...

@Igor_Tr · 11.12.2012, 16:14 **[ТС]**

Вы меня совсем угробить собрались?

Секунды, конечно. Разница была в одну секунду.
Шшас еще темку подкину.

Добавлено через 36 минут
Проверил Ваш последний вариант.... И мне стало грустно...

Я понял, что до проффэссора мне ну очень далеко. Спасибо!

Добавлено через 21 час 27 минут
Кто-то знает (может даже и почему), а кому-то будут интересны просто личные наблюдения. Что б "грабли" обойти. Изменил немного код, подсказаный от Апострофф, на

Visual Basic
1
2
3
4
5
6
7
8
With funFindCell: fa = .Value
   With .Offset(0, 1): fb = .Value                               
      With .Offset(0, 1): fc = .Value             
         With .Offset(0, 1): fd = .Value
          End With
      End With
   End With
End With

Работает. Прогнал на таблице в 22 столбца и 1300 рядов.
Время выполнения увеличилось. Хотя и не на много, но все-таки.... Вывод: VBA не очень уважает записть нескольких параметров в строку. Вернул обратно к Апострофф - опять скорость супер.

@Казанский · 11.12.2012, 19:14

Сообщение от Igor_Tr

Прогнал на таблице в 22 столбца и 1300 рядов.

Структура объединенных ячеек в каждой строке одинакова? Тогда загрузите всю таблицу в массив и выбирайте значения из нужных столбцов каждой строки массива. Получите ускорение более чам на порядок:

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
Sub bb()
Dim funFindCell As Range ' (здесь! только ячейка)
Dim fa%, fb%, fc%, fd As Integer
Dim t!, v(), i&
t = Timer
For Each funFindCell In [C1:C10000]
    With funFindCell
      fa = .Value
      With .Offset(0, 1)
        fb = .Value
        With .Offset(0, 1)
          fc = .Value
          With .Offset(0, 1)
            fd = .Value
          End With
        End With
      End With
    End With
Next
Debug.Print Timer - t
t = Timer
v = [C1:J10000].Value
For i = LBound(v) To UBound(v)
    fa = v(i, 1)
    fb = v(i, 3)
    fc = v(i, 6)
    fd = v(i, 8)
Next
Debug.Print Timer - t
End Sub

Мой результат (Excel 2007, Core2Duo 1.6ГГц)

Code
1
2
0,875
0,03125

@Igor_Tr · 11.12.2012, 20:26 **[ТС]**

To Казанский & Апострофф. У меня нет времени на перевод. Куча госей. Кидаю все мое творчество.

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Private Function func_РядокНумераційСтовпців _
                    (ByVal fnEndRow As Long, ByVal fnEndCol As Integer, _
                        Optional ByVal blFnCreateArrLines As Boolean = False)
    ' Велика допомога від "Апострофф", [url]https://www.cyberforum.ru[/url], _
        за що я йому дуже вдячний.
    ' Використовується при Option Base 1.
    ' Ця функція повертає: _
        - або значення номеру першого рядка _
                    з нумерацією стовпців (якщо встановлено, _
                                за замовчуванням, "False"); _
        - або масив номерів рядків, що містять нумерацію _
                стовпців (при виклику функції необхідно вказати "True")
    'А. Для виклику фукції з метою отримання номера першого рядка _
                        нумерації потрібно в процедурі записати інструкцію: _
        ЗміннаТипуLong = func_РядокНумераційСтовпців _
                                (ОстаннійПотрібнийРядокАркушу, _
                                                            ОстанняПотрібнаКолонкаАркушу)
    'Б. Для виклику фукції з метою отримати масив номерів всіх _
            рядків, що містять нумерацію стовпців потрібно вказати _
                                                                при виклику значення "True": _
        ЧистийДинамічнийМасивТипуVar = _
                func_РядокНумераційСтовпців _
        (ОстаннійРобочийРядокАркушу, ОстанняРобочаКолонкаАркушу, True)
    Dim funArr()
    Dim funArrRow()
    Dim fnStCol%, fa%, fb%, fc%, fd%, fi%, fnJ%, funMyVal As Integer
    Dim fnNsLines&, funMyRow&, funCount As Long
    Dim bFnStopFor As Boolean, bFnPartStopFor As Boolean
    Dim funRng As Range
    Dim funFrstCell As Range, funNextCell As Range, funFindCell As Range
        
    funCount = 0
    Erase funArrRow
    bFnStopFor = False
    
    Set funRng = Range(Cells(1, 1), _
                                            Cells(fnEndRow, fnEndCol))
    funMyVal = 1
 
        With funRng
        'по діапазону funRng починаємо пошук після _
            його останньої комірки Cells(fnEndRow, fnEndCol). _
                Тобто, з першої комірки ВКЛЮЧНО:
            Set funFrstCell = .Cells.Find(What:=funMyVal, _
                                    After:=Cells(fnEndRow, fnEndCol), _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchFormat:=False) '
            If funFrstCell Is Nothing Then
                MsgBox "Такого значення не знайдено !"
                    Exit Function
                        Else
                            bFnStopFor = True
                            ' funFrstCell.Select ' only test
            End If
                Do
                    '----------
                    If bFnStopFor = False Then
                        Set funNextCell = .Find(What:=funMyVal, _
                            After:=funFindCell, LookIn:=xlValues, _
                            LookAt:=xlWhole, SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, MatchCase:=False)
                        Set funFindCell = funNextCell
                        ' funFindCell.Select ' only test
                        If funNextCell.Address(False, False) = _
                                funFrstCell.Address(False, False) Then Exit Do
                    End If
                    '=====
                    '---------
                    If bFnStopFor = True Then
                        Set funFindCell = funFrstCell
                    End If
                    '=====
                    '---------
                        On Error Resume Next
                        With funFindCell
                            fa = .Value
                            With .Offset(0, 1)
                                fb = .Value
                                With .Offset(0, 1)
                                    fc = .Value
                                    With .Offset(0, 1)
                                        fd = .Value
                                    End With
                                End With
                            End With
                        End With
                        On Error GoTo 0
                        If fb = fa + 1 And fc = fb + 1 And fd = fc + 1 Then
                            funCount = funCount + 1
                            ReDim Preserve funArrRow(funCount)
                            funArrRow(funCount) = funFindCell.Row
                                If blFnCreateArrLines = False Then
                                    func_РядокНумераційСтовпців = _
                                            funArrRow(1)  ' ми шукали і знайшли _
                                                перший рядок нумерації стовпців. _
                                            При умові blFnCreateArrLines = True _
                                         зупиняємо все і передаємо значення _
                                                            в процедуру.
                                    Exit Function
                                End If
                        End If
                        '=====
                    bFnStopFor = False '
                Loop
        End With
    If blFnCreateArrLines = True Then
        func_РядокНумераційСтовпців = funArrRow  ' _
                        отримали масив всіх рядків, _
                                    які містять нумерацію стовпців
    End If
End Function

Добавлено через 12 минут
Прошу меня извинит. Sub для проверки:

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Sub Test_func_РядокНумераційСтовпців()
Dim MyArrayNew()
Dim i%, j%, mCounter%, myVal%
Dim LineNumbering As Long
Dim endR&, endC%
Dim stTime As Date, endTime As Date
Dim LngResTime As Long
Dim mstr$
Dim mRng As Range
Dim bStop As Boolean
Dim a%, b%, c%, d%, e%
    Application.DisplayAlerts = False
 
'''/////////////////////////////////////////////////////////////////////////
''заповнення аркушу даними для перевірки _
'    роботи функції func_ПершийРядокНумераційСтовпців _
'            (ByVal fnEndRow As Long, ByVal fnEndCol As Integer)
'    ActiveSheet.Cells.Delete
'    mCounter = 0
'    'записуємо числа у діапазон _
'                                        [a1] : [e10]
'    For i = 1 To 10
'        For j = 1 To 16
'            Cells(i, j).Value = Int((10 * Rnd()) + 1)
'        Next j
'    Next i
'     'міняємо деякі числові значення на текстові:
'    [a3] = "aple": [b2] = "dog": [c5] = "floor"
'    [d9] = "tobacco"
'    [a6] = "": [c2] = "": [c2].Interior.ColorIndex = 45
'    [d4] = "": [e8] = "": [e8].Interior.ColorIndex = 36
'    [f1] = "wanking": [g6] = 100
'    [b12] = 215: [e11] = "blend"
'
'    Range([a2], [b2]).MergeCells = True
'    Range([a4], [b4]).MergeCells = True
'    [a4] = 1
'    [a2] = 9
'    Range([h2], [j2]).MergeCells = True
'    [h2] = "golfAUTO"
'    [a4] = 1: Range([b4], [c4]).MergeCells = True
'    [d4] = 2
'    [e4] = 3: Range([f4], [g4]).MergeCells = True:
'    Range([f4], [g4]) = 4
'    Range([h4], [k4]).MergeCells = True:  Range([h4], [k4]) = 5
'    Range([L4], [n4]).MergeCells = True:  Range([L4], [n4]) = 6
'    Range([o4], [p4]).MergeCells = True: Range([o4], [p4]) = 7
''Stop
'    With Union([a4], Range([b4], [c4]), [d4], _
'                [e4], Range([f4], [g4]), Range([h4], [k4]), _
'                    Range([L4], [n4]), Range([o4], [p4]))
'                .HorizontalAlignment = xlCenter
'                .VerticalAlignment = xlCenter
'                .BorderAround Weight:=xlThick
'                .Borders(xlInsideVertical).Weight = xlThin
'                .Font.Bold = True
'                .Font.ColorIndex = 5
'    End With
''Stop
'    Range([a4], [p4]).Copy _
'        Union(Range([a14], [p14]), Range([a18], [p18]), _
'                                                        Range([a25], [p25])) ' _
'                        копіюємо рядок з нумрацією стовпців.
'    [a1] = 12: [b1] = 2: [c1] = 4: [d1] = 3: [e1] = 12: [g1] = 1
'''\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Stop
 
    Application.ScreenUpdating = False
 
    stTime = Timer ' вираховуємо час _
                                        виконання функції:
'------------------------------------------------------------------------------
''Stop
'    ' Так ми отримаємо номер першого рядка з нумерацією:
'    LineNumbering = func_РядокНумераційСтовпців _
'                        (ActiveSheet.UsedRange.Rows.Count, _
'                                    ActiveSheet.UsedRange.Columns.Count)
'    Rows(LineNumbering).EntireRow.Select
''    MsgBox "Перша Нумерація стовпців у рядку №   " & _
''                                                                                LineNumbering
'============================================
''Stop
'--------------------------------------------------------------------------------
    ' Так отримуємо масив всіх рядків, _
                                            що містять нумерацію стовпців:
MyArrayNew = func_РядокНумераційСтовпців _
                            (ActiveSheet.UsedRange.Rows.Count, _
                                    ActiveSheet.UsedRange.Columns.Count, True)
''Stop
'    'Видаляємо всі рядки з нумерацією:
    If Not Not MyArrayNew Then ' перевіряємо масив _
            MyArrayNew на наявність значень. Якщо він не _
                    пустий - видаляємо рядки, що відповідають _
                            записам масиву:
    Set mRng = Rows(MyArrayNew(1)).EntireRow
        For i = 2 To UBound(MyArrayNew)
            Set mRng = Union(mRng, Rows(MyArrayNew(i)).EntireRow)
        Next i
'Stop
    mRng.Select ' 1- й варіант для тестування.
'    mRng.Delete ' 2-й варіант для тестування.
    End If
'==============================================
    On Error Resume Next
    endTime = Timer
    LngResTime = endTime - stTime
    MsgBox "Час   виконання   -   " & LngResTime
Stop
'    a = UBound(MyArrayNew)
    Erase MyArrayNew
    Application.ScreenUpdating = True
End Sub

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .	SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .
SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .

@Igor_Tr 4377 / 661 / 36 Регистрация: 17.01.2010 Сообщений: 2,134
	10.12.2012, 14:43 [ТС]
	Не совсем. Прогнал и получил в результате fa=1 (правильно!), fb=2 (должно =2), fc=2 (должно =3), fd=3 (должно =4). Уточню, для чего это нужно. Получена таблица для анализа. Необходимо найти первую (или все) строку нумерации столбцов, а стоблцы содержат обьединенные ячейки. Добавлено через 7 минут Если через Select - тогда работает, но увеличивается время, не смотря на применение Application.ScreenUpdating = False. 0