Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск по образцу в Excel / 10 сообщений из 10, страница 1 из 1
03.06.2010, 16:03
    #36667099
dab2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
Привет всем! Уже полдня бьюсь над простым поиском ячейки по форматному образцу. Макрос записал, а когда пытаюсь сделать это же программно, то ничего не находится... т.е. объект С не задан. Причём поисковый оператор срисован с записанного макроса. Что подскажите?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
    Dim c As Range
    ...
    Set c = Cells.Find("", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True)
    ...
    c.Activate

Помогите с поиском строки в столбце по форматному образцу (текст в ячейке не важен).

============================================================================================================
"О, сколько нам открытий чудных готовит просвещения дух, и опыт - сын ошибок трудных, и гений - парадоксов друг, и случай - бог изобретатель" (Пушкин, однако).
...
Рейтинг: 0 / 0
03.06.2010, 16:48
    #36667300
_Boroda_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
dab2,

Код: plaintext
1.
2.
3.
4.
5.
6.
Sub tt()
Dim c As Range
    Set c = Cells.Find("", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True)
c.Activate
End Sub
работает нормально. В чем вопрос то?
...
Рейтинг: 0 / 0
03.06.2010, 17:03
    #36667374
vlth
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
dab2Помогите с поиском строки в столбце по форматному образцу.

Сначала образец поиска надо задать:
Код: plaintext
1.
2.
3.
4.
With Application.FindFormat
    .Clear
    .Font.Color = vbRed
    .Interior.Color = vbGreen
End With
Затем искать.
Поиск первой ячейки, соответствующей критерию:
Код: plaintext
Set c = Cells.Find("", After:=ActiveCell, SearchFormat:=True)
...
Рейтинг: 0 / 0
04.06.2010, 17:53
    #36670151
dab2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
Задаю критерии поиска, запускаю, а не находит! Вручную находит...
Выкладываю файл с прайсом - смысл найти по формату первой категории "БЫТОВАЯ ХИМИЯ, ЗАЩИТНЫЕ КРЕМЫ" другие строки с таким же форматом. Покажите как программно это находить, в т.ч. через
Код: plaintext
Cells.Find("", ActiveCell, xlFormulas, xlPart, xlByColumns, xlNext, False, True).Activate
У меня оператор отрабатывает и не находит, а должна найтись строка с таким же форматированием "Инструмент".
Помогите, буду признателен!
...
Рейтинг: 0 / 0
07.06.2010, 14:34
    #36673210
CyberBob
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
Прилагаю файл где в текстбоксе вводлтся искомая комбинация букв, кликнув кнопку filter выводдится соответствующие комбинации слова, может это вам подойдёт?
...
Рейтинг: 0 / 0
08.06.2010, 00:26
    #36674388
dab2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
К сожалению, этот пример без сравнения по формату, это строковое сравнение. Мне нужен поиск по формату образца. Кстати, м.б. у кого-то сделан уже?
...
Рейтинг: 0 / 0
08.06.2010, 06:56
    #36674523
vlth
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
Выкладываю файл с прайсом - смысл найти по формату первой категории "БЫТОВАЯ ХИМИЯ, ЗАЩИТНЫЕ КРЕМЫ"...

dab2, мы этот файл так и не увидели.
...
Рейтинг: 0 / 0
08.06.2010, 13:44
    #36675388
dab2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
vlth,

каюсь, выкладываю файл
...
Рейтинг: 0 / 0
08.06.2010, 17:56
    #36676202
vlth
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
dab2,
что-то Вы перемудрили с условиями поиска: я закомментировал показавшиеся мне лишними строки - и сразу всё заработало.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub Макрос2()
    Range("C10").Select
    Application.FindFormat.Clear
    With Application.FindFormat.Font
        .Name = "Arial"
        .FontStyle = "полужирный"
        .Size =  11 
'        .Strikethrough = False
'        .Superscript = False
'        .Subscript = False
'        .Underline = xlUnderlineStyleNone
'        .ColorIndex = 1
    End With
    With Application.FindFormat.Interior
        .ColorIndex =  54 
'        .Pattern = xlSolid
'        .PatternColorIndex = xlAutomatic
    End With
'    Application.FindFormat.Locked = True
'    Application.FindFormat.FormulaHidden = False
    Cells.Find(What:="", After:=ActiveCell, SearchFormat:=True).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
End Sub
...
Рейтинг: 0 / 0
22.06.2010, 14:22
    #36700596
dab2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск по образцу в Excel
Вот что получилось:

Код: plaintext
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.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
Option Explicit

Sub Группы()
Dim str As String, addr As String, addrend As String, curCell As Long, rng As Range

Application.FindFormat.Clear
'Application.FindFormat.NumberFormat = ActiveCell.NumberFormat
'    With Application.FindFormat
'        .HorizontalAlignment = ActiveCell.HorizontalAlignment  'xlGeneral
'        .VerticalAlignment = ActiveCell.VerticalAlignment  'xlTop
'        .WrapText = ActiveCell.WrapText  'True
'        .Orientation = ActiveCell.Orientation  '0
'        .AddIndent = ActiveCell.AddIndent  'False
'        .ShrinkToFit = ActiveCell.ShrinkToFit  'False
'        .MergeCells = ActiveCell.MergeCells  'False
'    End With
With Application.FindFormat.Font
  .Name = ActiveCell.Font.Name  '"Arial"
  .FontStyle = ActiveCell.Font.FontStyle  '"полужирный"
  .Size = ActiveCell.Font.Size  '11
'        .Strikethrough = ActiveCell.Font.Strikethrough  'False
'        .Superscript = ActiveCell.Font.Superscript  'False
'        .Subscript = ActiveCell.Font.Subscript  'False
'        .Underline = ActiveCell.Font.Underline  'xlUnderlineStyleNone
  .ColorIndex =  1 
End With
'    Application.FindFormat.Borders(xlLeft).LineStyle = ActiveCell.Borders(xlLeft).LineStyle  'xlNone
'    Application.FindFormat.Borders(xlRight).LineStyle = ActiveCell.Borders(xlRight).LineStyle 'xlNone
'    With Application.FindFormat.Borders(xlTop)
'        .LineStyle = ActiveCell.Borders(xlTop).LineStyle 'xlContinuous
'        .Weight = ActiveCell.Borders(xlTop).Weight  'xlThin
'        .ColorIndex = ActiveCell.Borders(xlTop).ColorIndex  'xlAutomatic
'    End With
'    With Application.FindFormat.Borders(xlBottom)
'        .LineStyle = ActiveCell.Borders(xlBottom).LineStyle  'xlContinuous
'        .Weight = ActiveCell.Borders(xlBottom).Weight  'xlThin
'        .ColorIndex = ActiveCell.Borders(xlBottom).ColorIndex  'xlAutomatic
'    End With
'    Application.FindFormat.Borders(xlDiagonalDown).LineStyle = ActiveCell.Borders(xlBottom).LineStyle  'xlNone
'    Application.FindFormat.Borders(xlDiagonalUp).LineStyle = ActiveCell.Borders(xlBottom).LineStyle  'xlNone
With Application.FindFormat.Interior
  .ColorIndex = ActiveCell.Interior.ColorIndex  '54
'        .Pattern = ActiveCell.Interior.Pattern  'xlSolid
'        .PatternColorIndex = ActiveCell.Interior.PatternColorIndex  'xlAutomatic
End With
'    Application.FindFormat.Locked = True
'    Application.FindFormat.FormulaHidden = False

On Error GoTo l1

str = ActiveSheet.UsedRange.AddressLocal
addrend = Mid(str, InStrRev(str, "$") +  1 )
addr = ActiveCell.Row
Cells.Find("", ActiveCell, xlFormulas, xlPart, xlByColumns, xlNext, False, , True).Activate

Application.ScreenUpdating = False

Do
  Set rng = ActiveCell

  curCell = ActiveCell.Row -  1 

  If ActiveCell.Row > addr Then
    Rows(CStr(addr +  1  & ":" & ActiveCell.Row -  1 )).Select
    Selection.Rows.Group
    Rows(ActiveCell.Row).ShowDetail = False
    'str = "SHOW.DETAIL(" & CStr(addr) & "," & CStr(curCell) & ",False,," & CStr(addr) - 1 & ")"

    'ExecuteExcel4Macro str
  End If
  addr = curCell +  1 
  
  rng.Select
  Cells.Find("", ActiveCell, xlFormulas, xlPart, xlByColumns, xlNext, False, , True).Activate
  'Cells.FindNext(ActiveCell).Activate
Loop While ActiveCell.Row > curCell
    
Rows(CStr(addr +  1  & ":" & addrend -  1 )).Select
Selection.Rows.Group
Rows(ActiveCell.Row).ShowDetail = False
Application.ScreenUpdating = True

Set rng = Nothing
    
Exit Sub
    
l1:
If Err.Number =  91  Then MsgBox "Не выделена ячейка с искомым форматом"

End Sub



Public Sub Меню()
Dim MyBar As CommandBar, MyButton( 0 ) As CommandBarButton

On Error GoTo l1

Set MyBar = Application.CommandBars.Add("Группа", msoBarTop, False, True)

With MyBar.Controls
   Set MyButton( 0 ) = .Add(msoControlButton,  1 , , , True)
End With
With MyButton( 0 )
   .FaceId =  3987 
   .Caption = "Скрыть"
   .TooltipText = "Группировать и свернуть группы"
   .Style = msoButtonIconAndCaption
   .OnAction = "Группы"
End With

Set MyBar = CommandBars("Группа")

MyBar.Visible = True

Exit Sub

l1:
CommandBars("Группа").Delete
Resume

End Sub

В событиях открытия рабочей книги поставить
Код: plaintext
1.
2.
3.
Private Sub Workbook_Open()
Call Группа.Меню
End Sub
Группа - имя этого модуля.
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / поиск по образцу в Excel / 10 сообщений из 10, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]