Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.90/303: Рейтинг темы: голосов - 303, средняя оценка - 4.90
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252

Макрос поиска и вывода строк, содержащих значение поиска

16.03.2012, 11:24. Показов 64995. Ответов 101
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Здравствуйте!
Есть макрос для поиска значения из ячейки А1 по всему листу и копированием строк из всех листов, содержащих это значение.
Но есть и проблема: макрос поиска ищет только цифровые значения из указанной ячейки. Текстовые или смешанные не находит.
Если знаете как подправить, помогите плз!!!
Вот код:
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
Sub SearchPN()
  Dim iCopi As Range
  Dim iPast As Range
  AR = Range("A1")   'значение для поиска
  SZ = 15
  PS = Cells(Rows.Count, 1).End(xlUp).Row
  Rows("15:" & PS).Delete Shift:=xlUp
  For I = 3 To 9
    IL = Cells(I, 5) 'номер листа
    KL = Cells(I, 6) 'номер столбца
    Cells(SZ, 2) = IL
    SZ = SZ + 1
    Set iCopi = Worksheets(IL).Range("A1:AD1")
    Set iPast = Worksheets("SEARCH").Range("A" & SZ)
    iCopi.Copy iPast
    SZ = SZ + 1
    PS = Sheets(IL).Cells(Rows.Count, KL).End(xlUp).Row
    For J = 2 To PS
      R = Val(Sheets(IL).Cells(J, KL))
      If Val(Sheets(IL).Cells(J, KL)) = AR Then
         Set iCopi = Worksheets(IL).Range("A" & J & ":AD" & J)
         Set iPast = Worksheets("SEARCH").Range("A" & SZ)
         iCopi.Copy iPast
         SZ = SZ + 1
      End If
    Next J
    SZ = SZ + 1
  Next I
End Sub
 
 
Sub Add_line()
    '
    ' Add_line Macro
    '
    ' Keyboard Shortcut: Ctrl+q
    '
    With ThisWorkbook.ActiveSheet
        Set iDiapazon = .UsedRange
        With iDiapazon
            nREnd = .Row + .Rows.Count - 1
            nCEnd = .Column + .Columns.Count - 1
        End With
        Set iDiapazon = Nothing
            
        If nREnd < 3 Then: MsgBox "Íå ïðîâåäåíî íè îäíîé îïåðàöèè.", vbInformation + vbOKOnly, "Ñîîáùåíèå ñèñòåìû": Exit Sub
            
'        MsgBox " - ñòðîêà " & nREnd & Chr(10) & " - ñòîëáåö " & nCEnd, vbInformation + vbOKOnly, "Êðàéíèå:"
        
        Rows(nREnd + 1).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        
        Range(.Cells(nREnd, 1), .Cells(nREnd, nCEnd)).Copy
        Range(.Cells(nREnd + 1, 1), .Cells(nREnd + 1, 1)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
 
    End With
End Sub
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
16.03.2012, 11:24
Ответы с готовыми решениями:

Макрос поиска вводимого значение и вывода всей строки
Привет! Ломаю голову уже несколько часов... Помогите, пожалуйста, срочно нужно написать что-то такое: я ввожу слово, макрос мне ищет...

разработать консольное приложение для ввода с клавиатуры массива строк и поиска среди них строк, содержащих заданный строковый фрагмент.
Помогите пожалуйстааа!!! Не пойму как это сделать на C#. Контрольное задание Необходимо разработать консольное приложение для...

Вывод количества строк в файлах, содержащих заданные строки поиска
Создайте командный файл, выводящий количество строк в файлах, содержащие за- данные строки поиска (с помощью команды find с параметром...

101
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
02.12.2013, 14:26  [ТС]
Студворк — интернет-сервис помощи студентам
Вы же видите, что этот макрос - плод коллекивного творчества форума Написали общими усилиями год назад - все работало
я убрал сейчас R - и все работает)
Напомнило, как друзья перебирали мотор в Гелинвагене. После переборки остался целый тазик болтиков, кронштейнов, релешек, и т.п. Гелен с тех пор ездеет уже 2 год без всяких проблем.

все гениальное должно быть просто!
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
02.12.2013, 14:47
Вполне может быть, что эта R публичная, Integer, и используется где-то позже в другом макросе - Вы ведь не показываете файл и всю задачу.
Ну а если она не нужна - то конечно она не нужна
А то что "Вы же видите" - да ничего я не вижу
0
0 / 0 / 0
Регистрация: 10.08.2015
Сообщений: 1
11.08.2015, 11:54
Здравствуйте! Нужна помощь Есть база в которой всего один лист,в нескольких столбцах два значения по функции =ЕСЛИ(P1>640;"Снять";"Начислить") на каждый месяц свое условие то есть на следующий месяц столбец уже будет выглядеть так =ЕСЛИ(P6>1640;"Снять";"Начислить") Нужна функция в которой есть поле "что искать" где указываем значение "Снять" или "Начислить"и поле где вводим название книги например "снятие с начисления" Итог нужно найти данные "Снять" и скопировать строки с ними в отдельную книгу "снятие с начисления" Вроде типа найти в выделенном столбце все данные соответствующие "Снять" и выделить строки где есть эти данные, или скопировать их в другую книгу, ну или если проще то на другой лист.В базе 70 тыс. строк в данный момент все делается вручную так как обычный поиск не выделяет строки.
База образец.xls

На оплату.xls

Снять с начисления.xls
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
08.09.2015, 13:01  [ТС]
Здравствуйте,
перестал работать поиск.
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
Application.EnableCancelKey = xlDisabled
  If Range("c1") = "" Then Exit Sub
   Application.ScreenUpdating = False
   Application.Calculation = xlAutomatic
  Dim iCopi As Range
  Dim iPast As Range
  Dim ar As String
  ar = CStr(Range("A1"))   '???????? ??? ??????
  sz = 15
  ps = Cells(Rows.Count, 1).End(xlUp).Row
  Rows("15:" & ps).Delete Shift:=xlUp
  For i = 4 To 9
    iL = Cells(i, 35) '????? ?????
    KL = Cells(i, 36) '????? ???????
    Cells(sz, 2) = iL
    sz = sz + 1
    Set iCopi = Worksheets(iL).Range("A1:AD1")
    Set iPast = Worksheets("SEARCH").Range("A" & sz)
    iCopi.Copy iPast
    sz = sz + 1
    ps = Sheets(iL).Cells(Rows.Count, KL).End(xlUp).Row
    For j = 2 To ps
      r = Val(Sheets(iL).Cells(j, KL))
      If CStr(Sheets(iL).Cells(j, KL)) Like ar Then
         Set iCopi = Worksheets(iL).Range("A" & j & ":AD" & j)
         Set iPast = Worksheets("SEARCH").Range("A" & sz)
         iCopi.Copy iPast
         sz = sz + 1
      End If
    Next j
    sz = sz + 1
  Next i
  Application.Calculation = xlManual
останавливается на r = Val(Sheets(iL).Cells(j, KL)). Пишет run error 6, Overflow.

в чем ошибка?
0
Модератор
Эксперт MS Access
 Аватар для shanemac51
12511 / 5085 / 814
Регистрация: 07.08.2010
Сообщений: 14,959
Записей в блоге: 4
08.09.2015, 13:12
останавливается на r = Val(Sheets(iL).Cells(j, KL)). Пишет run error 6, Overflow.
ошибка --переполнение
надо знать значения всех переменных il,j,kl и просмотреть значение данной ячейки
оно должно быть менее 2 000 0000 000
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
08.09.2015, 13:45  [ТС]
: iL : "block" : Variant/String
: j : 186 : Variant/Long
: KL : 6 : Variant/Double

стопариться, как я понял, на Листе "Блок". Поиск по 6му столбцу.
На листе около 500 позиций. 2 млн. точно не превышается

Добавлено через 7 минут
186 строка: 3E1214A00246. Формат текстовый.

Добавлено через 14 минут
вобщем, глюк именно тут... в номере 3E1214A00246.....
Эксель воспринимает как экспоненциональный формат, раскладывает число и ищет совпадение?
Пробывал помимо текст.формата ставить ещё и апостроф, и пробелы ... не помогает...
0
Модератор
Эксперт MS Access
 Аватар для shanemac51
12511 / 5085 / 814
Регистрация: 07.08.2010
Сообщений: 14,959
Записей в блоге: 4
08.09.2015, 13:59
val --это перевод в число
3E1214A00246 много более 2 000 000 000
вот и переполнение
1
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
08.09.2015, 15:17  [ТС]
Спасибо, понял.
Чем-нибудь можно заменить VAL?
А почему '3E1214A00246 в ячейке с форматом "текст" переводится в число? Апостроф же является как бы символом запрета на перевод в число и жесткой фиксацией "текста"...
0
15155 / 6428 / 1731
Регистрация: 24.09.2011
Сообщений: 9,999
09.09.2015, 00:08
Цитата Сообщение от mrf Посмотреть сообщение
Чем-нибудь можно заменить VAL?
А что собственно Вы хотите получить в переменной r? Эта переменная больше никак не используется в цикле - эта строка наверняка лишняя.
Цитата Сообщение от mrf Посмотреть сообщение
А почему '3E1214A00246 в ячейке с форматом "текст" переводится в число?
Потому что Val - функция для перевода текста в число. Хотя бы поставьте курсор в слово Val и нажмите F1.
1
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
09.09.2015, 11:02  [ТС]
Спасибо вам обоим!

r убрал в этом поиске, в других оставил, т.к. там действительно необходимо.
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
09.03.2016, 23:43  [ТС]
Здравствуйте,
подскажите, пожалуйста, как в данный макрос добавить поиск по 2-м значениям?
Visual Basic
1
2
3
  For i = 4 To 9 ' диапазон условий
    iL = Cells(i, 35) 'лист
    KL = Cells(i, 36) ' столбец
а нужно сделать
Visual Basic
1
2
3
4
  For i = 4 To 9 ' диапазон условий
    iL = Cells(i, 35) 'лист
    KL = Cells(i, 36) ' по этому столбец совпадение критерия №1
    KL1 = Cells(i, 37) ' а по этому столбцу совпадение критерия №2
Т.е. есть артикул и наименование. Сейчас ищет или по артикулу или по наименованию, хотелось бы, чтобы выводилось совпадение и по артикулу и по наименованию.
Например есть

1. болт ААА - 5 шт
2. Болт АААА - 10 шт
3. гайка ААА - 5 шт
4. гайка АААА - 10 шт
поиск артикула ААА дает много лишнего также как и поиск наименование "болт"
Вот надо, чтобы сразу вводили болт ААА и поиск выдавал на всех листах полные строчки с совпадением.

Заранее спасибо!
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
11.03.2016, 18:48  [ТС]
помогите,пожалуйста, собрать воедино и заставить работать следующие идеи:
1. добавляем второй критерий:
ar1 = CStr(Range("s1"))
2. добавляем где искать второй агрумент
KL1 = Cells(i, 33)
(надо ли под второй агрумент указывать диапозон имен листов как под первый критерий?)
3. меняем условие на совпадение по 1му и 2му агрументу
If CStr(Sheets(iL).Cells(j, KL)) Like ar And CStr(Sheets(iL).Cells(j, KL1)) Like ar1 Then
(вот тут ваще не понятно, сделал на обум, вроде строчку не высвечивает)

в итоге выходит ран-тайм еррор 1004 application-defined or object-defined error

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
  Application.ScreenUpdating = False
  Application.Calculation = xlAutomatic
  Dim iCopi As Range
  Dim iPast As Range
  Dim ar As String
  ar = CStr(Range("r1"))   '???????? ??? ??????
    ar1 = CStr(Range("s1"))   '???????? ??? ??????
  sz = 15
  ps = Cells(Rows.Count, 1).End(xlUp).Row
  Rows("15:" & ps).Delete Shift:=xlUp
  For i = 4 To 9
    iL = Cells(i, 31) '????? ?????
    KL = Cells(i, 32) '????? ???????
     KL1 = Cells(i, 33)
    Cells(sz, 2) = iL
    sz = sz + 1
    Set iCopi = Worksheets(iL).Range("A1:AD1")
    Set iPast = Worksheets("SEARCH").Range("A" & sz)
    iCopi.Copy iPast
    sz = sz + 1
    ps = Sheets(iL).Cells(Rows.Count, KL).End(xlUp).Row
    For j = 2 To ps
    '  r = Val(Sheets(iL).Cells(j, KL))
         If CStr(Sheets(iL).Cells(j, KL)) Like ar And CStr(Sheets(iL).Cells(j, KL1)) Like ar1 Then
         Set iCopi = Worksheets(iL).Range("A" & j & ":AD" & j)
         Set iPast = Worksheets("SEARCH").Range("A" & sz)
         iCopi.Copy iPast
         sz = sz + 1
      End If
    Next j
    sz = sz + 1
  Next i
Application.Calculation = xlManual
подправьте, плиз...
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
24.08.2016, 16:26  [ТС]
Здравствуйте,
можно ли в данном макросе обойтись как-нибудь без "Application.Calculation = xlAutomatic"? Книга большая, пересчет занимает много времени и, соответственно, вывод результатов поиска растягивается на долго. Есть альтернатива?
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
Private Sub CommandButton3_Click()
Sheets("SEARCH").Select
Application.EnableCancelKey = xlDisabled
  If Range("c1") = "" Then Exit Sub
   Application.ScreenUpdating = False
   Application.Calculation = xlAutomatic
  Dim iCopi As Range
  Dim iPast As Range
  Dim ar As String
  ar = CStr(Range("A1"))
  sz = 15
  ps = Cells(Rows.Count, 1).End(xlUp).Row
  Rows("15:" & ps).Delete Shift:=xlUp
  For i = 4 To 9
    iL = Cells(i, 35)
    KL = Cells(i, 36) '
    Cells(sz, 2) = iL
    sz = sz + 1
    Set iCopi = Worksheets(iL).Range("A1:AD1")
    Set iPast = Worksheets("SEARCH").Range("A" & sz)
    iCopi.Copy iPast
    sz = sz + 1
    ps = Sheets(iL).Cells(Rows.Count, KL).End(xlUp).Row
    For j = 2 To ps
      'r = Val(Sheets(iL).Cells(j, KL))
      If CStr(Sheets(iL).Cells(j, KL)) Like ar Then
         Set iCopi = Worksheets(iL).Range("A" & j & ":AD" & j)
         Set iPast = Worksheets("SEARCH").Range("A" & sz)
         iCopi.Copy iPast
         sz = sz + 1
      End If
    Next j
    sz = sz + 1
  Next i
  Application.Calculation = xlManual
Application.EnableCancelKey = xlInterrupt
   Application.ScreenUpdating = False
End Sub
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
24.08.2016, 16:54
Да макросу пофиг есть там промежуточный пересчёт или нет. А вот что там за задача - это Вы должны знать, нужно ли там промежуточно пересчитывать.
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
24.08.2016, 17:17  [ТС]
промежуточно пересчитывать не нужно, макрос ищет совпадающие значения в на листах в соответствующих столбцах, которые указаны в таблице и заданы условием
Visual Basic
1
2
3
 For i = 4 To 9
    iL = Cells(i, 35)
    KL = Cells(i, 36)
Но если отключить пересчет в начале, то результат не выводится. Проверял так: поиск с пересчетом - все ок, потом комментировал пересчет и менял критерий поиска - результат старый остается.
0
 Аватар для KoGG
5730 / 1633 / 419
Регистрация: 23.12.2010
Сообщений: 2,455
Записей в блоге: 1
25.08.2016, 09:35
Отключить пересчет.
Строки 28 -29 :
Visual Basic
1
2
         Set iPast = Worksheets("SEARCH").Range("A" & sz & ":AD" & sz)
         iPast.Value = iCopi.Value
0
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
25.08.2016, 16:01  [ТС]
отключил пересчет, изменил 28 и 29 строку - не ищет вобще.
включил, как было в начале, пересчет и изменил 28,29 строки - ищет быстрее, но выводит результаты без заливки. Это не совсем подходит, т.к. у меня на даблклик в зависимости от цвета записаны процедуры (переход на др.лист к позиции).
Другими словами, без пересчета не получилось.
0
 Аватар для KoGG
5730 / 1633 / 419
Регистрация: 23.12.2010
Сообщений: 2,455
Записей в блоге: 1
25.08.2016, 16:41
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
Private Sub CommandButton3_Click()
  Dim iCopi As Range, iPast As Range, ar As String, i&, j&, sz&, ps&, A, KL, iL
  Sheets("SEARCH").Select
  If Range("c1") = "" Then Exit Sub
  Application.ScreenUpdating = False
  Sheets("SEARCH").Select
  ar = CStr(Range("A1"))
  sz = 15
  ps = Cells(Rows.Count, 1).End(xlUp).Row
  Rows("15:" & ps).Delete Shift:=xlUp
  For i = 4 To 9
    Application.Calculation = xlAutomatic
    iL = Cells(i, 35)
    KL = Cells(i, 36) '
    Cells(sz, 2) = iL
    sz = sz + 1
    Set iCopi = Worksheets(iL).Range("A1:AD1")
    Set iPast = Worksheets("SEARCH").Range("A" & sz)
    ps = Sheets(iL).Cells(Rows.Count, KL).End(xlUp).Row
    A = Worksheets(iL).Range("A1:AD" & ps).Value
    Application.Calculation = xlManual
    iCopi.Copy iPast
    sz = sz + 1
    For j = 2 To ps
      If CStr(A(j, KL)) Like ar Then
         Set iCopi = Worksheets(iL).Range("A" & j & ":AD" & j)
         Set iPast = Worksheets("SEARCH").Range("A" & sz & ":AD" & sz)
         iCopi.Copy
         iPast.PasteSpecial Paste:=xlPasteValues
         iPast.PasteSpecial Paste:=xlPasteFormats
         sz = sz + 1
      End If
    Next j
    sz = sz + 1
  Next i
End Sub
1
12 / 12 / 4
Регистрация: 16.03.2012
Сообщений: 252
25.08.2016, 17:46  [ТС]
Спасибо большое!
Существенно быстрее: с 40-60 с до 12-15с!
0
0 / 0 / 0
Регистрация: 27.02.2018
Сообщений: 1
27.02.2018, 11:16
Всем привет, подскажите пожалуйста, а можно макросом решить следующую задачку.
У меня два разных файла. В одном у меня битые url адреса с кодом ответа сервера 404 и их много. А во втором файле у меня полный масив этих url адресов, часть нормальные, а часть соответственно битые с кодом 404.
Проблема в том, что битые url адреса не полностью совпадают текстом с общим массивом, так как url адреса в общем массиве содержат еще дополнительную разметку для аналитики. Если бы они полностью совпадали я бы использовал обычную формулу ВПР, но тут у меня совпадение только части текста и у меня не получается из-за этого найти битые ссылки с кодом 404 в общем массиве.
Может подскажет кто, как быть ?
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
27.02.2018, 11:16

Макрос поиска и копирования строк, которые совпадают с искомым значением
Здравствуйте, Нужно сделать макрос, который будет искать значение в таблице и выводить строки которые совпали с ним на другой лист, но в...

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

Запрет вывода строк содержащих значение #Ошибка
Подскажите пожалуйста как в можно в запросе указать такое условие отбора, чтобы строка содержащая значение &quot;#Ошибка&quot; не...

Как составить рег.выражение для поиска строк, содержащих только буквы, цифры, точки, и подчеркивания
подскажите, пожалуста, как составить рег.выражение для поиска сток, содержащих только буквы, цифры, точки, и подчеркивания. (все что...

Как доработать макрос для копирования строк из файлов, содержащих определенное значение
Подскажите пожалуйста, следующее: есть макрос для копирования строк из файлов, содержащих определенное значение: Sub...


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

Или воспользуйтесь поиском по форуму:
100
Ответ Создать тему
Новые блоги и статьи
Лето уходит
kumehtar 17.08.2026
Мысли в слух
kumehtar 17.08.2026
Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .
Перемещение строк из ТЧ в другой документ с учетом текущего пробега
Maks 17.08.2026
Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .
Саморегулирующийся социальный контракт для сервера cross-section.
Hrethgir 14.08.2026
С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .
Часы электронные
Uhbif79 12.08.2026
Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .
Часы с будильником на основе класса QLCDNumber
Uhbif79 12.08.2026
Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .
Установка MinGW GCC 16.2 и CMake
8Observer8 10.08.2026
VK Видео: https:/ / vkvideo. ru/ video-240781534_456239017 YouTube: eY5-5PyI9NM Текстовая версия
Неделя из жизни имитационной модели склада: мои кривые руки растут, откуда надо
anaschu 10.08.2026
Неделя из жизни имитационной модели склада: как я почти написал неправильную логику и что с этим делать Работаю сейчас над учебно-рабочим проектом: строю в AnyLogic имитационную модель процессов. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru