Контрольная проверка невыясненных вопросов...

Программирование на Visual Basic for Applications
sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Контрольная проверка невыясненных вопросов...

Сообщение sonata » 18.11.2003 (Вт) 15:12

Есть общий файл, в котором ведутся различные темы,
каждый лист определяет свою тему.
По теме могут возникать вопросы...
Ответы на которые, со временем хотелось бы выяснить...
Время проходит-вопросы забываются...И остаются невыясненными...
Что я хочу:
Делать проверку:по всем листам на наличие знака "?" или,
например, вопросительное предложение выделять особенным цветом,
наверное, это было бы быстрее при поиске,
а потом все ячейки копировать на отдельный лист, и напротив указывать
название листа...
Возможно ли такое реализовать?

Вот то, что я смогла придумать, но, видимо, все-таки
запуталась в циклах.
:roll:
Вопросы:
1) Все-таки добавляется лишний лист, вместо того,
чтобы делать проверку на лист с определенным названием,
если он существует, то удалять предыдущий и добавлять новый
2) Как осуществить снова переход на нужный лист при копировании
строчки?
3)ну и названия листов я не вставила напротив каждой строчки,
а хотелось бы...

Код: Выделить всё
Private Sub Question_Find()
Dim i, j, k As Integer

'i -счетчик для листов
'j-счетчик строк в каждом листе
'k- счетчик копируемых строк

'Добавляем лист с определенным названием,
'если он существует, то удаляем предыдущий и добавляем новый

Dim xxx As Integer
    xxx = ActiveWorkbook.Worksheets.Count
For i = 1 To xxx
            If (Sheets(i).Name = "Вопросы") Then
                Application.DisplayAlerts = False
                Sheets(i).Delete
                Application.DisplayAlerts = True
                Exit For
            End If
          Next i
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWorkbook.Sheets(xxx + 1).Name = "Вопросы"
'Если цвет ячейки в первом столбце каждого листа-желтый,
'то, копируем содержимое таких ячеек на новый лист...

k = 1
For i = 1 To Sheets.Count
Sheets(i).Activate
    For j = 1 To Rows.Count
    If (Cells(j, 1).Interior.ColorIndex = 6) Then
    Rows(j).Copy
    Sheets("Вопросы").Activate
    Rows(k).Select
        ActiveSheet.Paste
        'Видимо здесь путаница....так как
        'Sheets(i).Select
        k = k + 1

    End If
    Next j

Next i
End Sub
[/i]

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 18.11.2003 (Вт) 17:08

:)

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

Sub QFind()
  Const OutSheetName As String = "Вопросы"
  Dim outSh As Excel.Worksheet
  Dim tmpSh As Excel.Worksheet, tmpCell As Excel.Range, tmpLng As Long
 
  On Error Resume Next
  Application.DisplayAlerts = False
  Worksheets(OutSheetName).Delete
  Application.DisplayAlerts = True
  On Error GoTo 0
 
  Set outSh = Worksheets.Add
  outSh.Name = OutSheetName
 
  tmpLng = 1
  For Each tmpSh In Worksheets
    If Not (tmpSh Is outSh) Then
      For Each tmpCell In tmpSh.UsedRange.Columns(1).Rows
        If tmpCell.Interior.ColorIndex = 6 Then
          tmpCell.EntireRow.Copy outSh.Cells(tmpLng, 1)
          outSh.Cells(tmpLng, 1).Insert xlShiftToRight
          outSh.Cells(tmpLng, 1).Value = tmpSh.Name
          tmpLng = tmpLng + 1
        End If
      Next
    End If
  Next
End Sub
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Сообщение sonata » 18.11.2003 (Вт) 17:17

:shock: Как все красиво и быстро!!!
GSerg- Вы просто моя палочка-выручалочка! Только вот еще хотелось бы добавить рядом с вопросом,наименование листа, с которого производилось копирование...

sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Сообщение sonata » 18.11.2003 (Вт) 17:25

Код: Выделить всё
xxx = Sheets(tmpSh).Name
outSh.Cells(tmpLng, 2).Value = xxx

Так не работает-ошибочка выходит...
Вообще, законы объектного программирования плохо знаю... :oops:
Последний раз редактировалось sonata 18.11.2003 (Вт) 17:26, всего редактировалось 1 раз.

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 18.11.2003 (Вт) 17:25

Всё-таки успела скопировать первую версию кода? :) Там вторая уже давно! :)

ЗЫ: последний твой пост не понял :)
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

sonata
Постоялец
Постоялец
 
Сообщения: 321
Зарегистрирован: 31.07.2002 (Ср) 13:18
Откуда: Russia

Сообщение sonata » 18.11.2003 (Вт) 17:29

I am very happy! :wink:
Жаль, здесь не предусмотрены эмоционально-восхищенно-симпатизирующие смайлики :? Для того, чтобы передать свои восторженно-радостные эмоции, RayShade, только не обвиняй меня в том, что я отвечаю не по существу, плиз... :wink: Я только выражаю искреннюю благодарность!!!!
Последний раз редактировалось sonata 18.11.2003 (Вт) 17:34, всего редактировалось 1 раз.

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 18.11.2003 (Вт) 17:33

:)

www.smiliki.by.ru

Секундочку, sonata, а куда ты слово kiss стёрла? :P
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 55

    TopList  
cron