Страницы: 1 2 След.
RSS
VBA как компактнее написать перечисление условий
 
Добрый день, подскажите пожалуйста как запись вида
Код
If Cells(i, 1) = "6.3" Or Cells(i, 1) = "9.27" Or Cells(i, 1) = "9.30" Or Cells(i, 1) = "4.2" Or Cells(i, 1) = "2.32" _
Or Cells(i, 1) = "5.3" Or Cells(i, 1) = "12.1" Or Cells(i, 1) = "12.3" Or Cells(i, 1) = "12.9" Or Cells(i, 1) = "12.14" _
Or Cells(i, 1) = "12.15" Or Cells(i, 1) = "12.16" Or Cells(i, 1) = "12.17" Or Cells(i, 1) = "12.18" Or Cells(i, 1) = "12.19" _
Or Cells(i, 1) = "12.22" Or Cells(i, 1) = "12.25" Then
написать покороче
 
Код
If InStr(",6.3,9.27,9.30,4.2,2.32,5.3,12.1,12.3,12.9,12.14,12.15,12.16,12.17,12.18,12.19,12.22,12.25,", ", "& Cells(i, 1) & ",") > 0 Then
Изменено: БМВ - 17.09.2022 17:03:29
По вопросам из тем форума, личку не читаю.
 
СПАСИБО!!! а через Array как-то можно тоже сделать для варианта на будущее?
Изменено: Тимофеев - 17.09.2022 14:15:46
 
на будущее:
Код
a = Array(6.3, 9.27, 9.3, 4.2, 2.32, 5.3, 12.1, 12.3, 12.9, 12.14, 12.15, _
12.16, 12.17, 12.18, 12.19, 12.22, 12.25)
For j = 0 To UBound(a)
  If Cells(i, 1) = a(j) Then Exit For
Next
If j <= UBound(a) Then
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Код
    Select Case Cells(i, 1).Value
    Case 6.3, 9.27, 9.3, 4.2, 2.32, 5.3, 12.1, 12.3, 12.9, 12.14, 12.15, _
         12.16, 12.17, 12.18, 12.19, 12.22, 12.25
        MsgBox "QQ"
    End Select

Код
     Select Case Cells(i, 1).Value
    Case 6.3, 9.27, 9.3, 4.2, 2.32, 5.3, 12.1, 12.3, 12.9, 12.14, 12.15 To 12.19, 12.22, 12.25
        MsgBox "QQ"
    End Select
Изменено: RAN - 17.09.2022 14:49:11
 
Цитата
Тимофеев написал:
а через Array
Код
a = Array(6.3, 9.27, 9.3, 4.2, 2.32, 5.3, 12.1, 12.3, 12.9, 12.14, 12.15, _
12.16, 12.17, 12.18, 12.19, 12.22, 12.25)
If InStr(","&join(a,",")&",", ", "& Cells(i, 1) & ",") > 0 Then
Изменено: БМВ - 17.09.2022 17:04:09
По вопросам из тем форума, личку не читаю.
 
Строго говоря, в изначальном посте речь шла о текстовых значениях, так что верное направление только в посте #2. Хотя, конечно, сам код неправильный: перепутаны String expression: being searched и sought. Также и в #6.
Надеюсь, товарищ Тимофеев поблагодарил товарища БМВ, предварительно проверив и исправив код.


Апдейт: код в #2 исправлен.
Изменено: tolikt - 17.09.2022 17:24:01
 
На мой взгляд, для подобных задач лучше иметь универсальные функции. Например:
Код
' Проверяет наличие элемента value в массиве arr (любой размерности).
Function IsInArray(value, arr) As Boolean
  Dim v
  If IsArray(arr) Then
    For Each v In arr
      If v = value Then
        IsInArray = True
        Exit Function
      End If
    Next v
  End If
End Function
Владимир
 
Цитата
tolikt написал:
перепутаны String
спасибо.
По вопросам из тем форума, личку не читаю.
 
Если проверять миллион строк, то думаю быстрее сперва собрать эти критерии в словарь, и затем сверяться с ним.
Ну а для десятка строк можно ничего и не менять...
 
sokol92, приветствую. Тему не читал, не знаю, подойдёт или нет, но ещё можно вот так (просто для разнообразия)

Код
Sub Test()
    Dim arr As Variant
    arr = Array("one", "two", "three")
    MsgBox IsInArray(arr, "two"), , ""
End Sub

Function IsInArray(ByRef arr As Variant, stringToBeFound As String) As Boolean
    If IsArray(arr) Then
        IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
    End If
End Function
Изменено: New - 17.09.2022 20:43:17
 
Здравствуйте, Павел! Функция Filter ищет подстроки, а не значения:
Код
Debug.Print UBound(Filter(Array("a", "ab"), "a"))

выдаст 1 (а не 0).
Изменено: sokol92 - 17.09.2022 21:00:41
Владимир
 
sokol92, да, согласен, спасибо. Я уже забыл. Но вот почему бы Microsoft было не сделать какой-нибудь параметр у Filter, который бы отвечал искать вхождение (как InStr) или значение целиком.
P.S. Хотя, что for each, что Filter - и там и там цикл...
Изменено: New - 17.09.2022 22:09:57
 
Вариант через массив без цикла:
Код
Sub test()
    Dim arr(), i
    i = 1
    arr = Array("6.3", "9.27", "9.30", "4.2", "2.32", "5.3", "12.1", "12.3", "12.9", "12.14", "12.15", "12.16", "12.17", "12.18", "12.19", "12.22", "12.25")
    
    If Not IsError(Application.Match(Cells(i, 1), arr, 0)) Then
        MsgBox "ok"
    End If
End Sub
 
Ну тогда до кучи, ещё коллекция
Код
Sub Test()
    MsgBox IsInArray("9.30"), , ""
End Sub
 
Function IsInArray(stringToBeFound As String) As String
    With CreateObject("Scripting.Dictionary")
        For Each v In Array("6.3", "9.27", "9.30", "4.2", "2.32", "5.3", "12.1", "12.3", "12.9", "12.14", "12.15", "12.16", "12.17", "12.18", "12.19", "12.22", "12.25")
            .Add v, v
        Next
        If .Exists(stringToBeFound) Then IsInArray = "Ключ существует!"
    End With
End Function
 
Компактность "растет" с каждым постом  :D
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Компактность "растет" с каждым постом
Хорошо так будет покомпактнее
Код
Sub Test1()
    Set dic = CreateObject("Scripting.Dictionary")
    a = "9.30"
        For Each v In Array(a, "6.3", "9.27", "9.30", "4.2", "2.32", "5.3", "12.1", "12.3", "12.9", "12.14", "12.15", "12.16", "12.17", "12.18", "12.19", "12.22", "12.25")
            If Not dic.Exists(v) Then dic.Add v, v Else MsgBox "Ключ существует!"
        Next
End Sub
Изменено: Msi2102 - 19.09.2022 09:24:45
 
Цитата
webley: Вариант через массив без цикла:
цикл есть внутри Match и в целом будет медленнее большинства (если не всех) предложенных решений.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
написал:
Цитата
webley: Вариант через массив без цикла:
цикл есть внутри Match и в целом будет медленнее большинства (если не всех) предложенных решений.
строго говоря да, но в контексте рассматриваемой темы (проверка нескольких условий) быстродействие едва ли играет роль, речь скорее шла о компактности записи
 
Цитата
Jack Famous написал:
цикл есть внутри Match и в целом будет медленнее большинства
Была где-то тема, так там Match в тесте обогнал Find и перебора массива.. Чтоб быть справедливым, стоит сказать, знаком также с вашими выладками и тестами, где функции vba оказались быстрее  функций листа. По ним, кстати наглядно можно проследить, как влияют такие мелочи, как скобки при объявлении массива и прямое задание типа.
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=60709&TITLE_SEO=60709-chto-bystree-_-worksheetfinction.match-ili-find-ili-tsikl&MID=508309#message508309
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=133245&TITLE_SEO=133245-mozhno-li-bez-funktsiy-lista-vytashchit-stolbets-massiva-v-otdelnyy-ma&MID=1088079&tags=excel%2Colap#message1088079
Изменено: testuser - 19.09.2022 12:25:47
 
testuser, тема не про скорость, а ваши заявления слишком размыты.
Хотите скорости замерить - делайте полноценные тесты в отдельной теме (или давайте ссылки на существующие), а фразы "я где-то видел" оставьте для тех, кому этого достаточно. Можно сделать такой тест, в котором в лучшем виде себя покажет именно нужный метод, но корректным такой тест назвать будет нельзя.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, редактнул собщение. Кстати говоря, проверял сам недавно тот тест с match, поскольку было интересно как он покажет себя с массивом, но, как не странно, рейнджем он работает быстрее чем с массивом. С массивом, вроде бы время аналогичное Find.
Изменено: testuser - 19.09.2022 12:33:03
 
Цитата
testuser написал:
Match в тесте обогнал Find
А причем тут Find, по моему его никто не предлагал  :D
 
Доброго дня, еще вопрос про компактность, а то вручную скоро быстрее заполнить чем в коде прописать )
Прилагаю пример:
Задаю ширину столбца и заполняю построчно  - как можно это сделать массивом покороче?
Код
Set acadTable = acadDoc.PaperSpace.AddTable(InsertionPoint, 2, 46, 3, 20) 'Вставляем таблицу
                acadTable.RegenerateTableSuppressed = True
                acadTable.BreaksEnabled = True
                acadTable.RepeatTopLabels = True
                acadTable.TableBreakHeight = 1050
                acadTable.BreakSpacing = 10
                'acadTable.DeleteRows 0, 1
                acadTable.SetText 0, 0, .Range("AW" & 1).value
                acadTable.SetColumnWidth 0, 8 '1-й столбец
                acadTable.SetColumnWidth 1, 90 '2-й столбец
                acadTable.SetColumnWidth 2, 18 '3-й столбец
                acadTable.SetColumnWidth 3, 45 '4-й столбец
                acadTable.SetColumnWidth 4, 14 '5-й столбец
                acadTable.SetColumnWidth 5, 14 '6-й столбец
                acadTable.SetColumnWidth 6, 14 '7-й столбец
                acadTable.SetColumnWidth 7, 14 '8-й столбец
                acadTable.SetColumnWidth 8, 14 '9-й столбец
                acadTable.SetColumnWidth 9, 14 '10-й столбец
                acadTable.SetColumnWidth 10, 14 '11-й столбец
                acadTable.SetColumnWidth 11, 14 '12-й столбец
                acadTable.SetColumnWidth 12, 14 '13-й столбец
                acadTable.SetColumnWidth 13, 14 '14-й столбец
                acadTable.SetColumnWidth 14, 14 '15-й столбец
                acadTable.SetColumnWidth 15, 14 '16-й столбец
                acadTable.SetColumnWidth 16, 14 '17-й столбец
                acadTable.SetColumnWidth 17, 14 '18-й столбец
                acadTable.SetColumnWidth 18, 14 '19-й столбец
                acadTable.SetColumnWidth 19, 14 '20-й столбец
                acadTable.SetColumnWidth 20, 14 '21-й столбец
                acadTable.SetColumnWidth 21, 14 '22-й столбец
                acadTable.SetColumnWidth 22, 14 '23-й столбец
                acadTable.SetColumnWidth 23, 14 '24-й столбец
                acadTable.SetColumnWidth 24, 14 '25-й столбец
                acadTable.SetColumnWidth 25, 14 '26-й столбец
                acadTable.SetColumnWidth 26, 14 '27-й столбец
                acadTable.SetColumnWidth 27, 14 '28-й столбец
                acadTable.SetColumnWidth 28, 14 '29-й столбец
                acadTable.SetColumnWidth 29, 14 '30-й столбец
                acadTable.SetColumnWidth 30, 14 '31-й столбец
                acadTable.SetColumnWidth 31, 14 '32-й столбец
                acadTable.SetColumnWidth 32, 14 '33-й столбец
                acadTable.SetColumnWidth 33, 14 '34-й столбец
                acadTable.SetColumnWidth 34, 14 '35-й столбец
                acadTable.SetColumnWidth 35, 14 '36-й столбец
                acadTable.SetColumnWidth 36, 14 '37-й столбец
                acadTable.SetColumnWidth 37, 14 '38-й столбец
                acadTable.SetColumnWidth 38, 14 '39-й столбец
                acadTable.SetColumnWidth 39, 14 '40-й столбец
                acadTable.SetColumnWidth 40, 14 '41-й столбец
                acadTable.SetColumnWidth 41, 14 '42-й столбец
                acadTable.SetColumnWidth 42, 14 '43-й столбец
                acadTable.SetColumnWidth 43, 14 '44-й столбец
                acadTable.SetColumnWidth 44, 14 '45-й столбец
                acadTable.SetColumnWidth 45, 14 '46-й столбец
                    For i = 1 To LastRow
                        acadTable.InsertRows i, 5, 1
                        acadTable.RegenerateTableSuppressed = True
                        If .Range("AW" & i + 1).value <> 0 Then
                        acadTable.SetText i, 0, .Range("AW" & i + 1).value
                        End If
                        If .Range("AX" & i + 1) <> 0 Then
                        acadTable.SetText i, 1, .Range("AX" & i + 1).value
                        End If
                        If .Range("AY" & i + 1).value <> 0 Then
                        acadTable.SetText i, 2, .Range("AY" & i + 1).value
                        End If
                        If .Range("AZ" & i + 1).value <> 0 Then
                        acadTable.SetText i, 3, .Range("AZ" & i + 1).value
                        End If
                        If .Range("BA" & i + 1).value <> 0 Then
                        acadTable.SetText i, 4, .Range("BA" & i + 1).value
                        End If
                        If .Range("BB" & i + 1).value <> 0 Then
                        acadTable.SetText i, 5, .Range("BB" & i + 1).value
                        End If
                        If .Range("BC" & i + 1).value <> 0 Then
                        acadTable.SetText i, 6, .Range("BC" & i + 1).value
                        End If
                        If .Range("BD" & i + 1).value <> 0 Then
                        acadTable.SetText i, 7, .Range("BD" & i + 1).value
                        End If
                        If .Range("BE" & i + 1).value <> 0 Then
                        acadTable.SetText i, 8, .Range("BE" & i + 1).value
                        End If
                        If .Range("BF" & i + 1).value <> 0 Then
                        acadTable.SetText i, 9, .Range("BF" & i + 1).value
                        End If
                        If .Range("BG" & i + 1).value <> 0 Then
                        acadTable.SetText i, 10, .Range("BG" & i + 1).value
                        End If
                        If .Range("BH" & i + 1).value <> 0 Then
                        acadTable.SetText i, 11, .Range("BH" & i + 1).value
                        End If
                        If .Range("BI" & i + 1).value <> 0 Then
                        acadTable.SetText i, 12, .Range("BI" & i + 1).value
                        End If
                        If .Range("BJ" & i + 1).value <> 0 Then
                        acadTable.SetText i, 13, .Range("BJ" & i + 1).value
                        End If
                        If .Range("BK" & i + 1).value <> 0 Then
                        acadTable.SetText i, 14, .Range("BK" & i + 1).value
                        End If
                        If .Range("BL" & i + 1).value <> 0 Then
                        acadTable.SetText i, 15, .Range("BL" & i + 1).value
                        End If
                        If .Range("BM" & i + 1).value <> 0 Then
                        acadTable.SetText i, 16, .Range("BM" & i + 1).value
                        End If
                        If .Range("BN" & i + 1).value <> 0 Then
                        acadTable.SetText i, 17, .Range("BN" & i + 1).value
                        End If
                        If .Range("BO" & i + 1).value <> 0 Then
                        acadTable.SetText i, 18, .Range("BO" & i + 1).value
                        End If
                        If .Range("BP" & i + 1).value <> 0 Then
                        acadTable.SetText i, 19, .Range("BP" & i + 1).value
                        End If
                        If .Range("BQ" & i + 1).value <> 0 Then
                        acadTable.SetText i, 20, .Range("BQ" & i + 1).value
                        End If
                        If .Range("BR" & i + 1).value <> 0 Then
                        acadTable.SetText i, 21, .Range("BR" & i + 1).value
                        End If
                        If .Range("BS" & i + 1).value <> 0 Then
                        acadTable.SetText i, 22, .Range("BS" & i + 1).value
                        End If
                        If .Range("BT" & i + 1).value <> 0 Then
                        acadTable.SetText i, 23, .Range("BT" & i + 1).value
                        End If
                        If .Range("BU" & i + 1).value <> 0 Then
                        acadTable.SetText i, 24, .Range("BU" & i + 1).value
                        End If
                        If .Range("BV" & i + 1).value <> 0 Then
                        acadTable.SetText i, 25, .Range("BV" & i + 1).value
                        End If
                        If .Range("BW" & i + 1).value <> 0 Then
                        acadTable.SetText i, 26, .Range("BW" & i + 1).value
                        End If
                        If .Range("BX" & i + 1).value <> 0 Then
                        acadTable.SetText i, 27, .Range("BX" & i + 1).value
                        End If
                        If .Range("BY" & i + 1).value <> 0 Then
                        acadTable.SetText i, 28, .Range("BY" & i + 1).value
                        End If
                        If .Range("BZ" & i + 1).value <> 0 Then
                        acadTable.SetText i, 29, .Range("BZ" & i + 1).value
                        End If
                        If .Range("CA" & i + 1).value <> 0 Then
                        acadTable.SetText i, 30, .Range("CA" & i + 1).value
                        End If
                        If .Range("CB" & i + 1).value <> 0 Then
                        acadTable.SetText i, 31, .Range("CB" & i + 1).value
                        End If
                        If .Range("CC" & i + 1).value <> 0 Then
                        acadTable.SetText i, 32, .Range("CC" & i + 1).value
                        End If
                        If .Range("CD" & i + 1).value <> 0 Then
                        acadTable.SetText i, 33, .Range("CD" & i + 1).value
                        End If
                        If .Range("CE" & i + 1).value <> 0 Then
                        acadTable.SetText i, 34, .Range("CE" & i + 1).value
                        End If
                        If .Range("CF" & i + 1).value <> 0 Then
                        acadTable.SetText i, 35, .Range("CF" & i + 1).value
                        End If
                        If .Range("CG" & i + 1).value <> 0 Then
                        acadTable.SetText i, 36, .Range("CG" & i + 1).value
                        End If
                        If .Range("CH" & i + 1).value <> 0 Then
                        acadTable.SetText i, 37, .Range("CH" & i + 1).value
                        End If
                        If .Range("CI" & i + 1).value <> 0 Then
                        acadTable.SetText i, 38, .Range("CI" & i + 1).value
                        End If
                        If .Range("CJ" & i + 1).value <> 0 Then
                        acadTable.SetText i, 39, .Range("CJ" & i + 1).value
                        End If
                        If .Range("CK" & i + 1).value <> 0 Then
                        acadTable.SetText i, 40, .Range("CK" & i + 1).value
                        End If
                        If .Range("CL" & i + 1).value <> 0 Then
                        acadTable.SetText i, 41, .Range("CL" & i + 1).value
                        End If
                        If .Range("CM" & i + 1).value <> 0 Then
                        acadTable.SetText i, 42, .Range("CM" & i + 1).value
                        End If
                        If .Range("CN" & i + 1).value <> 0 Then
                        acadTable.SetText i, 43, .Range("CN" & i + 1).value
                        End If
                        If .Range("CO" & i + 1).value <> 0 Then
                        acadTable.SetText i, 44, .Range("CO" & i + 1).value
                        End If
                        If .Range("CP" & i + 1).value <> 0 Then
                        acadTable.SetText i, 45, .Range("CP" & i + 1).value
                        End If
                    Next
 
Цитата
Тимофеев написал:
как можно это сделать массивом покороче?
Как бы пистон не получить от админов
Но столько кода писать, жесть
Код
For i = 1 To LastRow
    acadTable.InsertRows i, 5, 1
    acadTable.RegenerateTableSuppressed = True
    For j = 1 To 46
        If .Cells(i + 1, 48 + j).Value <> 0 Then
            acadTable.SetText i, j - 1, .Cells(i + 1, 48 + j).Value
        End If
    Next
Next
Изменено: doober - 11.11.2022 15:27:19
 
doober,  :D  
Не бойтесь совершенства. Вам его не достичь.
 
doober, спасибо, буду разбираться наконец с циклом
 
Цитата
Тимофеев написал:
буду разбираться наконец с циклом
да уж давно пора, и судя по второму вопросу этой темы после ответов на первый ничего на эту мысль не навело ранее.
По вопросам из тем форума, личку не читаю.
 
можно, наверное еще так проверять наличие в массиве
Код
Sub test()
    Dim arr()
    Dim temp As String
    
    arr = Array("6.3", "9.27", "9.30", "4.2", "2.32", "5.3", "12.1", "12.3", "12.9", "12.14", "12.15", "12.16", "12.17", "12.18", "12.19", "12.22", "12.25")
    temp = Join(arr, "#")
    
    If Len(temp) <> Len(Replace(temp, Cells(1, 1), "")) Then
        MsgBox "ok"
    End If
End Sub
Изменено: Sergey Stoyanov - 11.11.2022 16:33:05
 
Что ж - добавим к первому вопросу… Тимофеев, апдейт варианта #2
Быстро и удобно и не громоздко
Для текста (если в массиве будут текстовые значения) в функцию можно добавить необязательный параметр игнора регистра…

Sergey Stoyanov, принцип у вас, как в #2, но не учтён важный нюанс и работает медленнее.
Подсказка: у вас в массиве "9,10" найдёт значения 0, 1 и 9, а их там нет  ;)
Изменено: Jack Famous - 11.11.2022 17:31:28
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1 2 След.
Наверх