Найти нужное значение в таблице по условию

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Всё отлично работает, причём во всех сетках! Только никак не могу понять, чем эта функция конфликтует с макросом на копирование значений диапазонов ячеек, предложенным вами в моей предыдущей теме (http://forum.developing.ru/showthread.p ... 0%BA/page2). Точнее даже не с ним, а с тем что я в него дописал. Для наглядности, пример во вложении. А дописал я строку

Код: Выделить всё

Sheets("Ход поединков").Range("B3 :D 482").ClearContents
До функции всё копировалось нормально, а теперь с первого копируемого диапазона, вместо значений выдаёт #ЗНАЧ. И главное, почему только с первого, а не со всех диапазонов? Я нашёл два параметра, из-за которых идёт конфликт, но так и не смог понять - почему. Первый, - это моя добавленная строка. Если я её убираю, то всё нормально копируется, но приходиться вручную очищать лист перед следующим копированием. Тут, кстати тоже не понятная ситуация, почему, если я убираю строку из макроса и перед копированием очищаю лист вручную, то всё копируется нормально, а если тоже действие произвожу с помощью макроса, то выскакивает этот ляп? Ну а второй параметр, это строка функции

Код: Выделить всё

Application.Volatile
Если её убрать, то копируется нормально. Но без неё формулы функции реагируют только на изменения в диапазонах поиска, что не всегда удобно. В принципе, не обязательно, чтобы формулы реагировали на любые изменения на листе, но помимо изменений в диапазонах поиска нужно реагирование и на изменения в диапазоне искомого значения, точнее справа от него, где выставляется "1" (победа).
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Всё отлично работает, причём во всех сетках! Только никак не могу понять, чем эта функция конфликтует с макросом на копирование значений диапазонов ячеек, и почему только с первым копируемым диапазоном? Вместо значений там выскакивает #ЗНАЧ! Наглядный пример во вложении. Это как-то связано со строкой в макросе

Код: Выделить всё

Sheets("Ход поединков").Range("B3:D482").ClearContents
и со строкой в функции

Код: Выделить всё

Application.Volatile
(т.е. без них всё копируется нормально), но в чём причина конфликта, - не моу понять.
Почему, или из-за чего происходит этот конфликт и можно ли это поправить, не теряя функциональности, т.е. чтобы и диапазон листа очищался перед копированием, и формулы реагировали на изменения листа или все области формулы, включая изменения в диапазоне искомого значения, точнее справа от него, где выставляется "1" (победа)?
Вложения
Book1..zip
(61 КБ) 39 скачиваний
SAS888
Сообщения: 156
Зарегистрирован: 16 янв 2008, 08:28

Причина в следующем: после 1-го копирования происходит изменение значений листа, и, как следствие, пересчет значений автопересчитываемых функций (Volatile). Для того, чтобы 1-й диапазон тоже копировался без ошибки, нужно при запуске макроса сделать пересчет "насильно". Посмотрите пример во вложении. В код макроса добавлен пересчет листа (Calculate).
Вложения
Book2..zip
(54.8 КБ) 36 скачиваний
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Да, я уже догадался (за два дня поиска причины...), доже по-своему решил проблему... Про Calculate я конечно же не знал, и перед копированием, в макросе прописал изменение соседней ячейки

Код: Выделить всё

Range("K5") = "Завершено"
Конечно же ваша поправка куда лучше и удобнее... Спасибо ещё раз!
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Вот ещё такая ситуация, надеюсь последняя... Данным макросом производится копирование всех первых страниц листов, в именах которых содержатся скобки, на отдельный лист для протокола...

Код: Выделить всё

Sub Создать_протокол_поединков()
    Dim Sh As Worksheet, i As Long
    i = 1
    Sheets("Протокол поединков").Cells.Clear
    For Each Sh In ThisWorkbook.Sheets
        If InStr(1, Sh.Name, "(") > 0 Then
            Sh.[A1:M39].Copy Sheets("Протокол поединков").Cells(i, 1)
            i = i + 39
        End If
    Next Sh
End Sub
Диапазон страницы A1:M39. Но если попадется лист с сеткой на 32 участника, то там данные для протокола не умещаются на одной странице и нужно копировать две. Можно ли дописать в макросе, что если на листе ячейка A30 не пустая, то копировать две страницы (диапазон двух страниц A1:M78)?
SAS888
Сообщения: 156
Зарегистрирован: 16 янв 2008, 08:28

Если я правильно Вас понял, То нужно это:

Код: Выделить всё

Sub Создать_протокол_поединков()
    Dim Sh As Worksheet, i As Long, x As Range
    i = 1
    Sheets("Протокол поединков").Cells.Clear
    For Each Sh In ThisWorkbook.Sheets
        If InStr(1, Sh.Name, "(") > 0 Then
            If [A30].Text = "" Then Set x = Sh.[A1:M39] Else Set x = Sh.[A1:M78]
            x.Copy
            Sheets("Протокол поединков").Cells(i, 1).PasteSpecial Paste:=xlPasteValues
            i = IIf([A30].Text = "", i + 39, i + 78)
        End If
    Next Sh
End Sub
И еще. Я бы копировал не полностью ячейки (с форматами, формулами и т. п.), а только значения (как в коде выше). Если, конечно, это Вам нужно...
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Спасибо, и ещё раз Спасибо! Это конечно же лучше! Я просто не знал как это делается... Даже не знаю как вас отблагодарить, вы столько раз мне помогли, и ни разу за это ничего не спросили, - "Низкой поклон и уважение"! Если что-то от меня будет нужно или я чем-то смогу вам помочь, - напишите в личку или сюда http://vk.com/vanblack
Буду рад оказаться вам полезным!
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Идея отличная, я и сам так считаю, но лист "Протокол поединков" пустой, т.е. без всяких таблиц, форматов и цветовых выделений. Выставить это заранее нельзя, т.к. неизвестно каков будет порядок сеток при формировании. Это будет зависеть от количества участников в возрастной и весовой категории, которое предугадать нельзя. Поэтому копировать только значения не даст нужного результата. Вот если бы копировалось всё, но только вместо формул копировались бы значения, было бы замечательно! И ещё, извиняюсь, что не совсем точно пояснил, копировать две страницы нужно если ячейка A30 не пустая на листе с которого происходит копирование. Сейчас, используя код выше, со всех листов скопировалось по две страницы.
SAS888
Сообщения: 156
Зарегистрирован: 16 янв 2008, 08:28

Попробуйте так:

Код: Выделить всё

Sub Создать_протокол_поединков()
    Dim Sh As Worksheet, i As Long, x As Range
    i = 1
    Sheets("Протокол поединков").Cells.Clear
    For Each Sh In ThisWorkbook.Sheets
        If InStr(1, Sh.Name, "(") > 0 Then
            If Sh.[A30].Text = "" Then Set x = Sh.[A1:M39] Else Set x = Sh.[A1:M78]
            With Sheets("Протокол поединков")
                x.Copy .Cells(i, 1)
                .Cells(Resize(x.Rows.Count, x.Columns.Count)).Value = .Cells(Resize(x.Rows.Count, x.Columns.Count)).Value
            End With
            If Sh.[A30].Text = "" Then i = i + 39 Else i = i + 78
        End If
    Next Sh
End Sub
Если что-то не так - прикрепите пример.
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Выдал ошибку в этой строке

Код: Выделить всё

.Cells(Resize(x.Rows.Count, x.Columns.Count)).Value = .Cells(Resize(x.Rows.Count, x.Columns.Count)).Value
и выделил синим второе Resize. Удалив строку всё скопировалось в нужном порядке, только опять выскочили #ЗНАЧ!, где формулы связаны с функцией.
Ответить