ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Переделать макрос для работы только в 2-х листах
7 сообщений из 7, страница 1 из 1
Переделать макрос для работы только в 2-х листах
    #33290819
Suleyman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Suleyman
Гость
Помогите пожалуйста переделать макрос для работы только в 2-х из 20-ти листов. Имена листов "Master" и " Officer"

Sub Count()
Dim intI As Integer
Dim rng As Range
Dim cel As Range

For intI = 2 To 20
With Worksheets(intI)
Set rng = Worksheets(intI).Range("C38, F38")
For Each cel In rng
Select Case cel.Value
Case 0
cel.Offset(0, 1).Value = "(Nil)"
Case 1
cel.Offset(0, 1).Value = "(One)"
Case 2
cel.Offset(0, 1).Value = "(Two)"
Case 3
cel.Offset(0, 1).Value = "(Three)"
Case 4
cel.Offset(0, 1).Value = "(Four)"
Case 5
cel.Offset(0, 1).Value = "(Five)"
Case 6
cel.Offset(0, 1).Value = "(Six)"
Case 7
cel.Offset(0, 1).Value = "(Seven)"
Case 8
cel.Offset(0, 1).Value = "(Eight)"
Case 9
cel.Offset(0, 1).Value = "(Nine)"
Case 10
cel.Offset(0, 1).Value = "(Ten)"
Case 11
cel.Offset(0, 1).Value = "(Eleven)"
Case 12
cel.Offset(0, 1).Value = "(Twelve)"
Case 13
cel.Offset(0, 1).Value = "(Thirteen)"
Case 14
cel.Offset(0, 1).Value = "(Fourteen)"
Case 15
cel.Offset(0, 1).Value = "(Fifteen)"
Case 16
cel.Offset(0, 1).Value = "(Sixteen)"
Case 17
cel.Offset(0, 1).Value = "(Seventeen)"
Case 18
cel.Offset(0, 1).Value = "(Eighteen)"
Case 19
cel.Offset(0, 1).Value = "(Nineteen)"
Case 20
cel.Offset(0, 1).Value = "(Twenty)"
Case 21
cel.Offset(0, 1).Value = "(Twenty one)"
Case 22
cel.Offset(0, 1).Value = "(Twenty two)"
Case 23
cel.Offset(0, 1).Value = "(Twenty three)"
Case 24
cel.Offset(0, 1).Value = "(Twenty four)"
Case 25
cel.Offset(0, 1).Value = "(Twenty five)"
Case 26
cel.Offset(0, 1).Value = "(Twenty six)"
Case 27
cel.Offset(0, 1).Value = "(Twenty seven)"
Case 28
cel.Offset(0, 1).Value = "(Twenty eight)"
Case 29
cel.Offset(0, 1).Value = "(Twenty nine)"
Case 30
cel.Offset(0, 1).Value = "(Thirty)"
Case 31
cel.Offset(0, 1).Value = "(Thirty one)"
End Select
Next cel
End With
Next intI
End Sub
...
Рейтинг: 0 / 0
27.09.2005, 13:58:41
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33290927
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
big-duke
Участник
Код: 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.
Sub Count()
    Dim intI As Integer
    Dim rng As Range
    Dim cel As Range
    
    For intI =  2  To  20 
        if Worksheets(intI).name="Master' or Worksheets(intI).name="Office" then
        With Worksheets(intI)
            Set rng = Worksheets(intI).Range("C38, F38")
            For Each cel In rng
                Select Case cel.Value
                    Case 0
                        cel.Offset(0, 1).Value = "(Nil)"
                    Case 1
                        cel.Offset(0, 1).Value = "(One)"
                    Case 2
                        cel.Offset(0, 1).Value = "(Two)"
                    Case 3
                        cel.Offset(0, 1).Value = "(Three)"
                    Case 4
                        cel.Offset(0, 1).Value = "(Four)"
                    Case 5
                        cel.Offset(0, 1).Value = "(Five)"
                    Case 6
                        cel.Offset(0, 1).Value = "(Six)"
                    Case 7
                        cel.Offset(0, 1).Value = "(Seven)"
                    Case 8
                        cel.Offset(0, 1).Value = "(Eight)"
                    Case 9
                        cel.Offset(0, 1).Value = "(Nine)"
                    Case 10
                        cel.Offset(0, 1).Value = "(Ten)"
                    Case 11
                        cel.Offset(0, 1).Value = "(Eleven)"
                    Case 12
                        cel.Offset(0, 1).Value = "(Twelve)"
                    Case 13
                        cel.Offset(0, 1).Value = "(Thirteen)"
                    Case 14
                        cel.Offset(0, 1).Value = "(Fourteen)"
                    Case 15
                        cel.Offset(0, 1).Value = "(Fifteen)"
                    Case 16
                        cel.Offset(0, 1).Value = "(Sixteen)"
                    Case 17
                        cel.Offset(0, 1).Value = "(Seventeen)"
                    Case 18
                        cel.Offset(0, 1).Value = "(Eighteen)"
                    Case 19
                        cel.Offset(0, 1).Value = "(Nineteen)"
                    Case 20
                        cel.Offset(0, 1).Value = "(Twenty)"
                    Case 21
                        cel.Offset(0, 1).Value = "(Twenty one)"
                    Case 22
                        cel.Offset(0, 1).Value = "(Twenty two)"
                    Case 23
                        cel.Offset(0, 1).Value = "(Twenty three)"
                    Case 24
                        cel.Offset(0, 1).Value = "(Twenty four)"
                    Case 25
                        cel.Offset(0, 1).Value = "(Twenty five)"
                    Case 26
                        cel.Offset(0, 1).Value = "(Twenty six)"
                    Case 27
                        cel.Offset(0, 1).Value = "(Twenty seven)"
                    Case 28
                        cel.Offset(0, 1).Value = "(Twenty eight)"
                    Case 29
                        cel.Offset(0, 1).Value = "(Twenty nine)"
                    Case 30
                        cel.Offset(0, 1).Value = "(Thirty)"
                    Case 31
                        cel.Offset(0, 1).Value = "(Thirty one)"
                End Select
            Next cel
        End With
       end if
    Next intI
End Sub
если листов будет много, то чтобы не усложнять конструкцию IF мона поставить Select case
...
Рейтинг: 0 / 0
27.09.2005, 14:28:14
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33291008
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Sub Count()
Dim intI as Integer
Dim rng As Range
Dim cel As Range
dim int2 as String

int2 ="Master"
For intI = 1 To 2
With Worksheets(int2)
Set rng = Worksheets(int2).Range("C38, F38")
For Each cel In rng
Select Case cel.Value
Case 0
cel.Offset(0, 1).Value = "(Nil)"
Case 1
cel.Offset(0, 1).Value = "(One)"
Case 2
cel.Offset(0, 1).Value = "(Two)"
Case 3
cel.Offset(0, 1).Value = "(Three)"
Case 4
cel.Offset(0, 1).Value = "(Four)"
Case 5
cel.Offset(0, 1).Value = "(Five)"
Case 6
cel.Offset(0, 1).Value = "(Six)"
Case 7
cel.Offset(0, 1).Value = "(Seven)"
Case 8
cel.Offset(0, 1).Value = "(Eight)"
Case 9
cel.Offset(0, 1).Value = "(Nine)"
Case 10
cel.Offset(0, 1).Value = "(Ten)"
Case 11
cel.Offset(0, 1).Value = "(Eleven)"
Case 12
cel.Offset(0, 1).Value = "(Twelve)"
Case 13
cel.Offset(0, 1).Value = "(Thirteen)"
Case 14
cel.Offset(0, 1).Value = "(Fourteen)"
Case 15
cel.Offset(0, 1).Value = "(Fifteen)"
Case 16
cel.Offset(0, 1).Value = "(Sixteen)"
Case 17
cel.Offset(0, 1).Value = "(Seventeen)"
Case 18
cel.Offset(0, 1).Value = "(Eighteen)"
Case 19
cel.Offset(0, 1).Value = "(Nineteen)"
Case 20
cel.Offset(0, 1).Value = "(Twenty)"
Case 21
cel.Offset(0, 1).Value = "(Twenty one)"
Case 22
cel.Offset(0, 1).Value = "(Twenty two)"
Case 23
cel.Offset(0, 1).Value = "(Twenty three)"
Case 24
cel.Offset(0, 1).Value = "(Twenty four)"
Case 25
cel.Offset(0, 1).Value = "(Twenty five)"
Case 26
cel.Offset(0, 1).Value = "(Twenty six)"
Case 27
cel.Offset(0, 1).Value = "(Twenty seven)"
Case 28
cel.Offset(0, 1).Value = "(Twenty eight)"
Case 29
cel.Offset(0, 1).Value = "(Twenty nine)"
Case 30
cel.Offset(0, 1).Value = "(Thirty)"
Case 31
cel.Offset(0, 1).Value = "(Thirty one)"
End Select
Next cel
End With
int2 ="Officer"
Next intI
End Sub
...
Рейтинг: 0 / 0
27.09.2005, 14:48:31
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33291969
Suleyman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Suleyman
Гость
Спасибо, все работает. Не много ошибся в определении задачи - в кол-ве листов, нужно было три, (еще один "CREW"). Сам я не очень соображаю в этом. Первый макрос переделал, а второй не получается, (просто интересно)
Если кому ни будь будет не в лом, подскажите.
Заранее благодарю
...
Рейтинг: 0 / 0
27.09.2005, 21:41:39
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33292267
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
смысл в следующем зачем бегать по всем листам если нужно по трем
красным выделено то что надо заменить или добавить
а проще скопируй и замени все от Sub count до end sub

Sub Count()
Dim intI As Integer
Dim rng As Range
Dim cel As Range
Dim List(1 To 3) As String
Dim int2 As String
List(1) = "Master"
List(2) = "Officer"
List(3) = "CREW"


For intI = 1 To 3
int2 = List(intI)
With Worksheets(int2)
Set rng = Worksheets(int2).Range("C38, F38")
For Each cel In rng
Select Case cel.Value
Case 0
cel.Offset(0, 1).Value = "(Nil)"
Case 1
cel.Offset(0, 1).Value = "(One)"
Case 2
cel.Offset(0, 1).Value = "(Two)"
Case 3
cel.Offset(0, 1).Value = "(Three)"
Case 4
cel.Offset(0, 1).Value = "(Four)"
Case 5
cel.Offset(0, 1).Value = "(Five)"
Case 6
cel.Offset(0, 1).Value = "(Six)"
Case 7
cel.Offset(0, 1).Value = "(Seven)"
Case 8
cel.Offset(0, 1).Value = "(Eight)"
Case 9
cel.Offset(0, 1).Value = "(Nine)"
Case 10
cel.Offset(0, 1).Value = "(Ten)"
Case 11
cel.Offset(0, 1).Value = "(Eleven)"
Case 12
cel.Offset(0, 1).Value = "(Twelve)"
Case 13
cel.Offset(0, 1).Value = "(Thirteen)"
Case 14
cel.Offset(0, 1).Value = "(Fourteen)"
Case 15
cel.Offset(0, 1).Value = "(Fifteen)"
Case 16
cel.Offset(0, 1).Value = "(Sixteen)"
Case 17
cel.Offset(0, 1).Value = "(Seventeen)"
Case 18
cel.Offset(0, 1).Value = "(Eighteen)"
Case 19
cel.Offset(0, 1).Value = "(Nineteen)"
Case 20
cel.Offset(0, 1).Value = "(Twenty)"
Case 21
cel.Offset(0, 1).Value = "(Twenty one)"
Case 22
cel.Offset(0, 1).Value = "(Twenty two)"
Case 23
cel.Offset(0, 1).Value = "(Twenty three)"
Case 24
cel.Offset(0, 1).Value = "(Twenty four)"
Case 25
cel.Offset(0, 1).Value = "(Twenty five)"
Case 26
cel.Offset(0, 1).Value = "(Twenty six)"
Case 27
cel.Offset(0, 1).Value = "(Twenty seven)"
Case 28
cel.Offset(0, 1).Value = "(Twenty eight)"
Case 29
cel.Offset(0, 1).Value = "(Twenty nine)"
Case 30
cel.Offset(0, 1).Value = "(Thirty)"
Case 31
cel.Offset(0, 1).Value = "(Thirty one)"
End Select
Next cel
End With
Next intI
End Sub
...
Рейтинг: 0 / 0
28.09.2005, 08:48:06
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33292291
Пользователь2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пользователь2
Гость
Для первого варианта:

Код: plaintext
1.
2.
        If Worksheets(intI).Name = "Master" Or _
          Worksheets(intI).Name = "Officer" Or _
          Worksheets(intI).Name = "Crew" Then

Для второго:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
    Dim int2 As String

    On Error Resume Next
    
    int2 = "Master"
    For intI =  1  To  3 
        If intI =  2  Then
            int2 = "Officer"
        ElseIf intI =  3  Then
            int2 = "Crew"
        End If
        With Worksheets(int2)
        ...
    Next intI
...
Рейтинг: 0 / 0
28.09.2005, 09:03:35
| Ответить | Цитировать | Написать  
Переделать макрос для работы только в 2-х листах
    #33293044
Suleyman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Suleyman
Гость
Спасибо!
...
Рейтинг: 0 / 0
28.09.2005, 13:16:15
| Ответить | Цитировать | Написать  
7 сообщений из 7, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Переделать макрос для работы только в 2-х листах
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=33291969&tid=2167109]:
 0ms
get settings:
 8ms
get forum list:
 13ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 37ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 32ms
get tp. blocked users:
 1ms
others: 217ms
total:  321ms
созд. / загр.: 321ms
x
x
Закрыть


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