Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Переделать макрос для работы только в 2-х листах / 7 сообщений из 7, страница 1 из 1
27.09.2005, 13:58:41
    #33290819
Suleyman
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
Помогите пожалуйста переделать макрос для работы только в 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, 14:28:14
    #33290927
big-duke
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
Код: 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:48:31
    #33291008
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
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, 21:41:39
    #33291969
Suleyman
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
Спасибо, все работает. Не много ошибся в определении задачи - в кол-ве листов, нужно было три, (еще один "CREW"). Сам я не очень соображаю в этом. Первый макрос переделал, а второй не получается, (просто интересно)
Если кому ни будь будет не в лом, подскажите.
Заранее благодарю
...
Рейтинг: 0 / 0
28.09.2005, 08:48:06
    #33292267
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
смысл в следующем зачем бегать по всем листам если нужно по трем
красным выделено то что надо заменить или добавить
а проще скопируй и замени все от 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, 09:03:35
    #33292291
Переделать макрос для работы только в 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, 13:16:15
    #33293044
Suleyman
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Переделать макрос для работы только в 2-х листах
Спасибо!
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Переделать макрос для работы только в 2-х листах / 7 сообщений из 7, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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