Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сравнить Range с заданным интервалом (0-50) и записать .. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сравнить Range с заданным интервалом (0-50) и записать .. (Макросы Sub)
Сравнить Range с заданным интервалом (0-50) и записать ..
bozanov Дата: Четверг, 28.11.2013, 00:04 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel для Mac
Дана таблица с 5 столбцами, в ней значения от 0 до 50, нужно узнать каких цифр в данной таблице из промежутка 0 - 50 нет и затем вывести их в отдельный столбец.
3 43 19 48 32
42 28 34 24 18
26 13 27 7 10
9 41 25 46 39
24 41 7 25 22
34 2 11 29 23

как решить данную задачу, с условием того, что при добавлении нового ряда из 5 цифр, значения стоблца должны менятся в соответствии с появлением новых цифр?


Сообщение отредактировал bozanov - Четверг, 28.11.2013, 00:05
 
Ответить
СообщениеДана таблица с 5 столбцами, в ней значения от 0 до 50, нужно узнать каких цифр в данной таблице из промежутка 0 - 50 нет и затем вывести их в отдельный столбец.
3 43 19 48 32
42 28 34 24 18
26 13 27 7 10
9 41 25 46 39
24 41 7 25 22
34 2 11 29 23

как решить данную задачу, с условием того, что при добавлении нового ряда из 5 цифр, значения стоблца должны менятся в соответствии с появлением новых цифр?

Автор - bozanov
Дата добавления - 28.11.2013 в 00:04
Pelena Дата: Четверг, 28.11.2013, 00:18 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19197
Репутация: 4423 ±
Замечаний: ±

Excel 365 & Mac Excel
Формулы не предлагать?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеФормулы не предлагать?

Автор - Pelena
Дата добавления - 28.11.2013 в 00:18
bozanov Дата: Четверг, 28.11.2013, 00:32 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel для Mac
Формулы не предлагать?


если это возможно, т.к. ряды в таблице будут пополнятся через макрос (задание номер два)
 
Ответить
Сообщение
Формулы не предлагать?


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

Автор - bozanov
Дата добавления - 28.11.2013 в 00:32
SkyPro Дата: Четверг, 28.11.2013, 01:33 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1206
Репутация: 255 ±
Замечаний: 0% ±

2010
[vba]
Код
Option Explicit

Sub exists50()
Dim x
Dim ar50&(0 To 50)
Dim i&, r&, c&, g&: g = 0
Dim arRes&(1 To 100000, 1 To 1)
Dim exists As Boolean: exists = False

For i = 0 To 50
      ar50(i) = i
Next

x = Range("A1:E" & [a65535].End(xlUp).Row)

For i = 0 To 50
exists = False
      For r = 1 To UBound(x)
          For c = 1 To 5
              If x(r, c) = ar50(i) Then
                  exists = True
              End If
          Next
      Next
      If exists = False Then
      g = g + 1
          arRes(g, 1) = ar50(i)
      End If
Next
If g = 0 Then Exit Sub
[g1].Resize(g) = arRes
End Sub
[/vba]


skypro1111@gmail.com

Сообщение отредактировал SkyPro - Четверг, 28.11.2013, 01:49
 
Ответить
Сообщение[vba]
Код
Option Explicit

Sub exists50()
Dim x
Dim ar50&(0 To 50)
Dim i&, r&, c&, g&: g = 0
Dim arRes&(1 To 100000, 1 To 1)
Dim exists As Boolean: exists = False

For i = 0 To 50
      ar50(i) = i
Next

x = Range("A1:E" & [a65535].End(xlUp).Row)

For i = 0 To 50
exists = False
      For r = 1 To UBound(x)
          For c = 1 To 5
              If x(r, c) = ar50(i) Then
                  exists = True
              End If
          Next
      Next
      If exists = False Then
      g = g + 1
          arRes(g, 1) = ar50(i)
      End If
Next
If g = 0 Then Exit Sub
[g1].Resize(g) = arRes
End Sub
[/vba]

Автор - SkyPro
Дата добавления - 28.11.2013 в 01:33
KuklP Дата: Четверг, 28.11.2013, 06:19 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Пара вариантов:
[vba]
Код
Public Sub www()
     Dim a, v, b(0 To 50, 1 To 1), i&, n&
     a = [a1].CurrentRegion: [g1].CurrentRegion.ClearContents
     With CreateObject("scripting.dictionary")
         For Each v In a
             .Item(v) = ""
         Next
         For i = 0 To 50
             If .exists(i) Then Else b(n, 1) = i: n = n + 1
         Next
     End With
     [g1].Resize(n + 1) = b
End Sub

Public Sub www1()
     Dim a, j&, b(0 To 50, 1 To 1), i&, n&, m&, f As Boolean
     a = [a1].CurrentRegion: f = -1
     [h1].CurrentRegion.ClearContents
     On Error Resume Next
     With Application
         For j = 0 To 50
             For i = 1 To UBound(a, 2)
                 m = .Match(j, .Index(a, 0, i), 0)
                 If Err Then Err.Clear Else f = 0: Exit For
             Next
             If f Then b(n, 1) = j: n = n + 1
             f = -1
         Next
     End With
     [h1].Resize(n + 1) = b
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Четверг, 28.11.2013, 07:17
 
Ответить
СообщениеПара вариантов:
[vba]
Код
Public Sub www()
     Dim a, v, b(0 To 50, 1 To 1), i&, n&
     a = [a1].CurrentRegion: [g1].CurrentRegion.ClearContents
     With CreateObject("scripting.dictionary")
         For Each v In a
             .Item(v) = ""
         Next
         For i = 0 To 50
             If .exists(i) Then Else b(n, 1) = i: n = n + 1
         Next
     End With
     [g1].Resize(n + 1) = b
End Sub

Public Sub www1()
     Dim a, j&, b(0 To 50, 1 To 1), i&, n&, m&, f As Boolean
     a = [a1].CurrentRegion: f = -1
     [h1].CurrentRegion.ClearContents
     On Error Resume Next
     With Application
         For j = 0 To 50
             For i = 1 To UBound(a, 2)
                 m = .Match(j, .Index(a, 0, i), 0)
                 If Err Then Err.Clear Else f = 0: Exit For
             Next
             If f Then b(n, 1) = j: n = n + 1
             f = -1
         Next
     End With
     [h1].Resize(n + 1) = b
End Sub
[/vba]

Автор - KuklP
Дата добавления - 28.11.2013 в 06:19
KuklP Дата: Четверг, 28.11.2013, 07:05 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Еще:
[vba]
Код
Public Sub www2()
     Dim j&, b(0 To 50, 1 To 1), n&, rng As Range
     Set rng = [a1].CurrentRegion
     [h1].CurrentRegion.ClearContents
     For j = 0 To 50
         If Application.CountIf(rng, j) = 0 Then b(n, 1) = j: n = n + 1
     Next
     [h1].Resize(n + 1) = b
End Sub
[/vba]
;)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Четверг, 28.11.2013, 07:18
 
Ответить
СообщениеЕще:
[vba]
Код
Public Sub www2()
     Dim j&, b(0 To 50, 1 To 1), n&, rng As Range
     Set rng = [a1].CurrentRegion
     [h1].CurrentRegion.ClearContents
     For j = 0 To 50
         If Application.CountIf(rng, j) = 0 Then b(n, 1) = j: n = n + 1
     Next
     [h1].Resize(n + 1) = b
End Sub
[/vba]
;)

Автор - KuklP
Дата добавления - 28.11.2013 в 07:05
AndreTM Дата: Четверг, 28.11.2013, 07:09 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Внесу свою лепту :)
[vba]
Код
Sub test()
     Dim a(0 To 50) As Boolean, rng As Range, c As Range, i&
     Set rng = [a1].CurrentRegion
     For Each c In rng.Cells
         a(c.Value) = True
     Next
     Set rng = [g1].CurrentRegion
     rng.ClearContents
     For i = 0 To 50
         If Not a(i) Then
             rng.Cells(1, 1) = i
             Set rng = rng.Offset(1)
         End If
     Next
End Sub
[/vba]


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеВнесу свою лепту :)
[vba]
Код
Sub test()
     Dim a(0 To 50) As Boolean, rng As Range, c As Range, i&
     Set rng = [a1].CurrentRegion
     For Each c In rng.Cells
         a(c.Value) = True
     Next
     Set rng = [g1].CurrentRegion
     rng.ClearContents
     For i = 0 To 50
         If Not a(i) Then
             rng.Cells(1, 1) = i
             Set rng = rng.Offset(1)
         End If
     Next
End Sub
[/vba]

Автор - AndreTM
Дата добавления - 28.11.2013 в 07:09
bozanov Дата: Пятница, 29.11.2013, 00:36 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel для Mac
спасибо большое всем!!! первый же ответ решил мою задачу! =)
 
Ответить
Сообщениеспасибо большое всем!!! первый же ответ решил мою задачу! =)

Автор - bozanov
Дата добавления - 29.11.2013 в 00:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сравнить Range с заданным интервалом (0-50) и записать .. (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!