Дана таблица с 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 цифр, значения стоблца должны менятся в соответствии с появлением новых цифр?
Дана таблица с 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
Сообщение отредактировал bozanov - Четверг, 28.11.2013, 00:05
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]
[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
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]
Пара вариантов: [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
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]
Еще: [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
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]
Внесу свою лепту [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