Страницы: Пред. 1 2 3
RSS
Скрыть строку при равенстве значений в двух столбцах
 
TSN
огромное спасибо. все работает
на рабочем файле использую Sub HiddenRowArr() время 1.2 сек
 
Цитата
sergey2303 написал: на рабочем файле использую Sub HiddenRowArr() время 1.2 сек
Замечательно :)  желаемого результата достигли.  Успехов в работе.
Изменено: TSN - 10.09.2015 21:59:26
 
TSN
а можете в последней версии Sub HiddenRowArr() добавить закраску строк, тех что остались не скрити?
(закраска строки A-J)
 
TSN
а можете скинуть ваш скайп?
 
TSN
мне нужно
найти пустую строчку на Листе3 после даних через строчку написать "отсутсвуют дание", затем через строчку вставить ети дание
(строки что будут активни(не скрити) после отработки макроса  Sub HiddenRowArr())
 
Не совсем понял вашу просьбу, процедура скрывает все строки которые попали под условие скрытия.
Все оставшиеся строки видно как на ладони, зачем их еще красить ?
Какова цель данного действия ?
 
может и красить не нужно
мне нужно
найти пустую строчку на Листе3 после даних, через строчку написать "отсутсвуют дание", затем через строчку вставить ети дание
(строки что будут активни(не скрити) после отработки макроса  Sub HiddenRowArr())
Изменено: sergey2303 - 14.09.2015 14:27:54
 
Ну вот цель оказывается совсем другая, насколько я понял, не обязательно даже скрывать строки. Достаточно было пройти циклом по данным листа ("Ax:Fx") отобрать не подпадающие под определенные условия в (массив и/или коллекцию) и перегрузить ответ на Лист3 дописав в конец таблицы.
Если просили окраску замените процедуру на эту
Скрытый текст
 
TSN
сначала била цель  скривать строки, и анализировать, но теперь хотелось би вивести на другой лист
(найти пустую строчку на Листе3 после даних, через строчку написать "отсутсвуют дание", затем через строчку вставить ети дание
(строки что будут активни(не скрити) после отработки макроса  Sub HiddenRowArr()))
можно ваш скайп в личку?
Изменено: sergey2303 - 14.09.2015 15:11:32
 
На работе скайпа нет. После работы я редко сижу за компом, на работе такого добра хватает.
Выложите пример данных файл до 100 кб., что есть (какие данные нужно отбирать с листа 380*) и что нужно получить (куда их выгрузить).
Я посмотрю когда будет время, как изменить текущую процедуру Sub HiddenRowArr и получить желаемый результат.
 
А я предвидел :)
http://planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=69336&TITLE_SEO=69336-skryt-strok...
 
нужно сравнить колонку F листа380* с колонкой А листа1. Те строки в которих нет совпадений с Листа380* скопировать на Лист3
и с названием в ячейке D ("отсутствуют дание")
Изменено: sergey2303 - 14.09.2015 15:48:51
 
Цитата
Hugo написал: А я предвидел
Я тоже видел, что нужен другой подход. Но был интерес победить скрытие несмежных строк в большом множестве.  :)
Цитата
нужно сравнить колонку F листа380* с колонкой А листа1.
Уже реализовано
Цитата
Те строки в которих нет совпадений с Листа380* скопировать на Лист3 и с названием в ячейке D ("отсутствуют дание")
А это новая часть.
Изменено: TSN - 14.09.2015 15:55:35
 
Цитата
sergey2303 написал: Нужно сравнить колонку F листа380* с колонкой А листа1. Те строки в которих нет совпадений с Листа380* скопировать на Лист3 и с названием в ячейке D ("отсутствуют дание")
Новая процедура согласно Вашей просьбы и приложенного примера.
Выполняет только выгрузку новых записей по городам. Новые данные дописываются к уже имеющимся на Листе3 с отступом.
Скрытый текст
Изменено: TSN - 15.09.2015 11:00:35
 
TSN
на рабочем файле ошибка
Runtime-time error '457':
This key is already associated with an element of this collection
oSDnew.Add arr(x, 1), 0
 
Тут описка:
Код
If Not oSD.exists(arr(x, 1)) Then oSDnew.Add arr(x, 1), 0
А вообще можно добавлять без проверки:
Код
словарь.item(arr(x, 1))=0
Если ключа нет - добавится с нулём, если есть - ноль перезапишется на другой ноль.
 
TSN
а можете протестить на моем файле что я отправлял по поште?
 
Цитата
sergey2303 написал: This key is already associated with an element of this collection
Это предупреждение словаря о существующем ключе в коллекции.
замените строку 34
Код
If Not IsEmpty(arr(x, 1)) Then If Not oSD.exists(arr(x, 1)) Then oSDnew.Add arr(x, 1), 0
на вариант предложенный Hugo
Код
If Not IsEmpty(arr(x, 1)) Then If Not oSD.exists(arr(x, 1)) Then oSDnew.Item(arr(x, 1)) = 0
 
Цитата
Hugo написал: А вообще можно добавлять без проверки:
Оказывается мои познания в Scripting.Dictionary неполноценны. Мой вариант загрузки был бы более громоздкий
Код
If Not IsEmpty(arr(x, 1)) Then
   If Not oSD.exists(arr(x, 1)) Then '''проверка по листу 380*
      If Not oSDnew.exists(arr(x, 1)) Then oSDnew.Add arr(x, 1), 0 '''загрузка в словарь итог с проверкой
   End If
End If
Hugo спасибо
 
TSN
я не правильно обяснил то что нужно, в итоге результат не тот
Нужно с листа 380* скопировать на лист3 те строки(всю строку) в которих есть пустая ячейка в колонке Е но если ячейка F листа 380*  равна ячейке A Листа1 то не копировать
перевиложил пример
 
Последние варианты построены на массивах, всю строку загружать в массив нет смысла, скажите какова реальная ширина таблицы на листе 308* (сколько колонок таблицы ексель) ?
Когда освобожусь по основной работе напишу еще один вариант.
А в целом если Вы хотите реализовать серьезный проект на работе без самостоятельного изучения VBA  далеко не уедеш.  
 
TSN
10 колонок
 
Цитата
Нужно с листа 380* скопировать на лист3 те строки(всю строку) в которих есть пустая ячейка в колонке Е но если ячейка F листа 380* равна ячейке A Листа1 то не копировать
Вариант с перегрузкой проанализированных данных на Лист3 (всей строкой). Тестируйте.
Скрытый текст
Изменено: TSN - 15.09.2015 17:03:11
 
TSN
все супер. Большое спасибо
а можете еще етот макрос подправить для все также, только Лист2 и для пустой ячейки в колонке D
я подправил но, не тот результат(Sub GetEmptyRows22() нужно бутет запускать сразу после Sub GetEmptyRows())
Код
Option Explicit
Option Compare Text
 
Sub GetEmptyRows22()
'''Процедура выполняет анализ Листа 380* на основании имеющихся записей на Листе1
'''Окончательный результат массив стсрок выгружается на Лист3
Dim oSD As Object, oColl As New Collection
Dim oSht1 As Worksheet, oSht3 As Worksheet, oRng As Range, vl
Dim arr(), arrTemp, x As Long, m As Byte, iRow As Long
Dim iCore As Long, iTimer As Single
Dim sDelimetr As String, sTemp
Const iColumns As Byte = 10
 
sDelimetr = Chr(169)
iTimer = Timer
Set oSD = CreateObject("Scripting.Dictionary"): oSD.comparemode = 1
  With ActiveWorkbook
    For Each vl In .Worksheets
        If vl.Name Like "380*" Then
            Set oSht1 = .Sheets(vl.Name)
        ElseIf vl.Name Like "Лист3" Then
            Set oSht3 = .Sheets(vl.Name)
        End If
    Next
    If oSht1 Is Nothing Then MsgBox "Листа 380* нет в файле, досрочное завершение работы", vbCritical: Exit Sub
    If oSht3 Is Nothing Then MsgBox "Листа3 нет в файле, досрочное завершение работы", vbCritical: Exit Sub
    ''' c этого листа отбираем данные для дальнейшего анализа
    With .Sheets("Лист2"): arr = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value: End With
      For x = LBound(arr) To UBound(arr):  If Not oSD.exists(arr(x, 1)) Then oSD.Add arr(x, 1), 0
      Next x
    Erase arr
    ''' Работаем с листом 380* анализ условий и загрузка данных в коллекцию, _
        Это не самый оптимальный вариант (два цикла) по времени исполнения, _
        можно Сразу грузить весь массив более чем >100000*10 записей в память и Redim arrItog(,), после циклом. _
        В формате экономии памяти так лучше.
    With oSht1
      Set oRng = .Range(.Cells(1, 4), .Cells(Rows.Count, 6).End(xlUp)) 'начинаем загрузку с 1-й строки
      iCore = oRng(1).Row - 1 '''корректировка строки в массиве для скрытия
      arr = oRng.Value2
        For x = LBound(arr) To UBound(arr)      ''' цикл по массиву из поля F листа 380*
          If Not IsEmpty(arr(x, 2)) Then        ''' пропускаем пустую запись по F
           If IsEmpty(arr(x, 1)) And Not oSD.exists(arr(x, 2)) Then
             For Each vl In .Range(.Cells(x + iCore, 1), .Cells(x + iCore, iColumns))
               sTemp = sTemp & vl.Value & sDelimetr
             Next
             oColl.Add Left(sTemp, Len(sTemp) - 1): sTemp = vbNullString
            End If
          End If
        Next x
    End With
    ''' Перегрузка в массив
    ReDim arr(1 To oColl.Count, 1 To iColumns): x = 0
    For Each vl In oColl
      x = x + 1: arrTemp = Split(vl, sDelimetr, -1, 1)
      For m = 0 To iColumns - 1: arr(x, m + 1) = arrTemp(m): Next m
    Next
    '''Выгружаем данные на Лист3
    With oSht3
      iRow = .Cells(Rows.Count, 6).End(xlUp).Row + 2   '''поиск последней строки + отступ
      .Cells(iRow, 4).Font.Bold = True ' поле "D"
      .Cells(iRow, 4).Value = "Відсутні обдастні центри"
      .Cells(iRow + 1, 1).Resize(UBound(arr), iColumns) = arr
      .Activate
    End With
End With
Set oSht3 = Nothing: Set oSht1 = Nothing: Set oRng = Nothing: Set vl = Nothing
Set oSD = Nothing: Set oColl = Nothing: Erase arr: Erase arrTemp
MsgBox "Выполнено за " & Timer - iTimer & " с.", vbInformation, "VBA: GetEmptyRows"
End Sub


Изменено: sergey2303 - 15.09.2015 17:25:34
 
Подправлю, только завтра на работе. Сейчас пиво с рыбкой не дает думать.  :)
В целом можно одной процедурой выполнить две задачи и получить результат.
 
Цитата
sergey2303 написал: а можете еще етот макрос подправить для все также, только Лист2 и для пустой ячейки в колонке D я подправил но, не тот результат
Выкладывать еще одну процедуру нет смысла, я их тут и так наплодил.  :) .   А небольшой анализ Вашего подправленного кода проведу.
строка 37 кода      
Код
Set oRng = .Range(.Cells(1, 4), .Cells(Rows.Count, 6).End(xlUp)) 'начинаем загрузку с 1-й строки
Ссылку на диапазон данных сделана верно  .Cells(1, 4) -  4 является столбцом (полем) "D", .Cells(Rows.Count, 6) -  6 является столбцом (полем) "F". После чего перегрузили данные в массив и вошли цикл по массиву, а дальше ошибка анализа данных в строках 41, 42
Обратите внимание, что в моем примере процедура загружает данные в массив с .Cells(1, 5) и .Cells(Rows.Count, 6), то есть массив имеет размерность arr (1 to x, 1 to 2), а в вашем случае arr (1 to x, 1 to 3) - изменилась размерность массива. Следовательно изменилась ссылка на данные в массиве при анализе, а именно на поле "F" таблицы и если изменить строки 41, 42 на: ... всё опять будет работать как надо.
Код
If Not IsEmpty(arr(x, 3)) Then        ''' пропускаем пустую запись по F
   If IsEmpty(arr(x, 1)) And Not oSD.exists(arr(x, 3)) Then

Повторюсь еще раз. Две процедуры обрабатывающие одни данные (с небольшим различием в анализе) на более чем 100000 строк не эффективно. Лучше подкорректировать текущую, добавив 10 строк кода и получить результат работы двух процедур, хотя если скорость выполнения не критична и полученные данных по двум вариантам нужны в разное время то можно оставить и так.
Изменено: TSN - 16.09.2015 13:39:09
 
TSN
спасибо. работает.
а можете еще помочь с макросом
нужно, например, если есть пустая ячейка в колонке F, то скопировать строки на Лист3, с шапкой "Отстутствуют дание"
 
sergey2303, Вы уже растянули тему на три страницу. И каждый раз всё новые и новые пожелания... Какое отношение Ваш вопрос имеет к заявленной теме?
 
Цитата
Юрий М написал: Вы уже растянули тему на три страницу. И каждый раз всё новые и новые пожелания... Какое отношение Ваш вопрос имеет к заявленной теме?
Полностью согласен.  
Цитата
TSN написал: А в целом если Вы хотите реализовать серьезный проект на работе без самостоятельного изучения VBA  далеко не уедеш.
Полностью согласен.
 
TSN
а можете еще добовить одно условие для копирования строк?
нужно еще копировать строки, если пустие ячейки E и F b и не пустая С
(строки копировать вместе с теми что описани в посте 80 и под одной шапкой)
Страницы: Пред. 1 2 3
Наверх