FindFormat

[Puffi.Muffi]

Всем привет!

Подскажите, пожалуйста, как записать макрос:

Необходимо найти все ячейки на листе определенного формата, например

Application.FindFormat.NumberFormat = "#,##0.00;#,##0.00-"
Application.FindFormat.Font.FontSty le = "Полужирный"

выделить их, и вставить в определенный диапазон.


Пробовала записать макрос проделав вручную операции в книги (excel2010) (разработчик -> записать макрос):

- Ctrl+F
- Options
- Format
- задаю необходимый мне формат
- Find all
- Ctrl + A
- активирую лист в котором работаю
- Ctrl + C
- и вставляю значения куда необходимо

Однако, повторить записанный макрос с необходимым результатом Excel не может, копируется только первая ячейка данного формата (а нужны все!).

Плиз, скажите как можно добиться нужного результата.

[kalbasiatka]

Может цикл какой прикрутить?

[Puffi.Muffi]

думала об этом,
но там сложность в том, что ячейки находятся поочередно,
и каждый раз становится активной новая ячейка, а нужно все сразу.
что-то ничего в голову не приходит...

[kalbasiatka]

Может от Вас пример "поочерёдности" увидим в .xls например?

[IgorGO]

отметьте одну ячейку, нажмите Ctrl отметьте другую несмежную ячейку (не имеющую общей границы с первой), а теперь нажмите Ctrl+C, читайте надпись.

найти все нужные ячейки и обединить их в диапазон не проблема (это диапазон составленый из множества областей), а вот потом скопировать...

[Puffi.Muffi]

Kalbasiatka,

была идея написать:

Sub vv()
Dim x As Integer
For x = 1 To 1000
If Cells(x, "B").NumberFormat = "#,##0.00;#,##0.00-" Then
Cells(x, "B").Copy
Range("H1").End(xlDown).Offset(1, 0).Activate
ActiveSheet.Paste
End If
Next x
End Sub

однако объемы большие и такой код занимает очень много времени (особенно если нужно переносить на другой лист),

Классно было бы если в нижеследующем коде каждый раз прибавлялся бы к выбранному диапазону новый, а не скидывался старый и выбирался новый:

Sub vv()
Dim x As Integer
For x = 1 To 1000
If Cells(x, "B").NumberFormat = "#,##0.00;#,##0.00-" Then

Cells(x, "B").Select

End If
Next x
End Sub

[Puffi.Muffi]

IgorGO,

а как такое сделать, ссылаясь не на конкретные ячейки,
а именно на те, которые подходят под определенный формат?

[IgorGO]

Sub Start()
  Dim rg As Range
  Set rg = FindMyNumFormat("#,##0.00;#,##0.00-")
  If Not rg Is Nothing Then rg.Interior.Color = RGB(255, 0, 0)
End Sub

Function FindMyNumFormat(f As String) As Range
  Dim rg As Range, rgf As Range
  Application.FindFormat.Clear:  Application.FindFormat.NumberFormat = f
  Set rgf = Cells.Find(What:="", SearchFormat:=True)
  Do While Not rgf Is Nothing
    If rg Is Nothing Then Set rg = rgf Else Set rg = Application.Union(rg, rgf)
    Set rgf = Cells.Find("", rgf, SearchFormat:=True)
    If Not Application.Intersect(rg, rgf) Is Nothing Then Exit Do
  Loop
  Set FindMyNumFormat = rg
End Function

[kalbasiatka]

Взял 10 000 ячеек, из них 9000 подходящих под условие, заняло 5 секунд:

Sub vv()
 Dim x As Integer
 k = 1
 For x = 1 To 10000
 If Cells(x, 2).NumberFormat = "#,##0.00;#,##0.00-" Then
 Cells(x, 2).Copy Cells(k, 8)
 k = k + 1
 End If
 Next x
 End Sub

[Puffi.Muffi]

IgorGO,
идея интересная, ее мне нужно додумать: может очень подойти для другого проекта.
Единственное что, я боюсь писать коды с Do While.

Kalbasiatka,
в данном случае код вполне подходит.

Спасибо Вам Большое за уделенное время!