Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Евгений Минаков
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 След.
Упрощение кода склонения падежей
 
#
09.11.2021 17:01:22
Теперь понятно :)  Спасибо всем!
 
Перейти    
Упрощение кода склонения падежей
 
#
08.11.2021 18:51:05
Спасибо, БМВ, а что вы имеете ввиду "авторское количество пробелов"?
 
Перейти    
Упрощение кода склонения падежей
 
#
08.11.2021 00:17:19
БМВ, подскажите, пожалуйста, можно ли доработать этот код так, чтобы менялось каждое слово в должности?
 
Перейти    
Упрощение кода склонения падежей
 
#
07.11.2021 22:28:26
Вообще нужно примерно так

Код
Option Compare Text    ' эта строка нужна обязательно! (сравнение без учёта регистра)

Function GenitivePostCase(Optional sEpis$) As String



Dim j As Long


For j = 1 To 100
    Application.Volatile True    ' автопересчёт формулы на листе
    sEpis$ = Replace(sEpis$, " - ", "-"): sEpis$ = Replace(Replace(sEpis$, " -", "-"), "- ", "-")
Next
On Error Resume Next
    If (sEpis$ = "") Then
        Arr = Split(Application.Trim(sEpis$))
        sEpis$ = Arr(j)
    End If


    If Len(sEpis) > 0 Then    '   должность
        arrEpis = Split(sEpis, "-")
        For i = LBound(arrEpis) To UBound(arrEpis)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpisPart = arrEpis(i)

                Select Case Right(sEpisPart, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpisPart, 1, Len(sEpisPart)) & "а"
                    Case "ь": sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 1) & "я"
                    Case "я": sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 1) & "ю"
                        If UBound(arrEpis) > 0 And i = 0 Then sRes = sEpisPart
                    Case Else: sRes = sEpisPart & ""
                End Select

                Select Case Right(sEpisPart, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 2) & "ка"
                    Case "ец":  sRes = Mid(sEpisPart, 1, Len(sEpisPart) - 2) & "ца"
                End Select


            arrEpis(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis, "-") & " "     ' соединяем части склоняемой должности обратно в одну строку
 End If
    GenitivePostCase = Replace(GenitivePostCase, "-", "- ")
    GenitivePostCase = Replace(GenitivePostCase, "- ", "-")
End Function

Загвоздка в том, что этот код склоняет часть должности где есть дефис, а где его нет - не склоняет
Например: должность     "менеджер-продавец" склоняет "менеджера-продавца", а "старший менеджер-продавец"  склоняет не полностью
"старший менеджера-продавца"
Изменено: Евгений Минаков - 07.11.2021 23:47:48
 
Перейти    
Упрощение кода склонения падежей
 
#
07.11.2021 15:39:02
БМВ, подскажите, пожалуйста, для sEpis2,sEpis3  и т.д. как-то по-другому будет выглядеть?
 
Перейти    
Склонение фамилий по падежам
 
#
07.11.2021 13:03:04
Вообще брал отсюда https://excelvba.ru/code/DativeCase
Потом просто переделал под свои задачи
 
Перейти    
Упрощение кода склонения падежей
 
#
07.11.2021 00:18:53
Не посоветуете где почитать можно? Я с программированием вообще никак.
 
Перейти    
Упрощение кода склонения падежей
 
#
06.11.2021 23:20:14
Здравствуйте, уважаемые форумчане!
Немного переделал под себя код для склонения падежей.
Вопрос в следующем: как можно упростить код с учетом того, что там процедуры повторяются?
Код
Function GenitivePostCase(sEpis1$, Optional sEpis2$, Optional sEpis3$, Optional sEpis4$, _
Optional sEpis5$, Optional sEpis6$) As String



    Application.Volatile True    ' автопересчёт формулы на листе
    sEpis1$ = Replace(sEpis1$, " - ", "-"): sEpis1$ = Replace(Replace(sEpis1$, " -", "-"), "- ", "-")
    sEpis2$ = Replace(sEpis2$, " - ", "-"): sEpis2$ = Replace(Replace(sEpis2$, " -", "-"), "- ", "-")


    On Error Resume Next
    If (sEpis2$ = "" And sEpis3$ = "" And sEpis4$ = "") Then
        Arr = Split(Application.Trim(sEpis1$))
        sEpis1$ = Arr(0): sEpis2$ = Arr(1): sEpis3$ = Replace(Arr(2), ".", ""): sEpis4$ = Arr(3): _
        sEpis5$ = Arr(4): sEpis6$ = Arr(5): sEpis7$ = Arr(6): sEpis8$ = Arr(7): sEpis9$ = Arr(8): _
        sEpis10$ = Arr(9): sEpis11$ = Arr(10): sEpis12$ = Arr(11): sEpis13$ = Arr(12): sEpis14$ = Arr(13): _
        sEpis15$ = Arr(14): sEpis16$ = Arr(15): sEpis17$ = Arr(16): sEpis18$ = Arr(17): sEpis19$ = Arr(18)
    End If


    If Len(sEpis1) > 0 Then    '   должность
        arrEpis1 = Split(sEpis1, "-")
        For i = LBound(arrEpis1) To UBound(arrEpis1)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis1Part = arrEpis1(i)

                Select Case Right(sEpis1Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis1Part, 1, Len(sEpis1Part)) & "а"
                    Case "ь": sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 1) & "ю"
                        If UBound(arrEpis1) > 0 And i = 0 Then sRes = sEpis1Part
                    Case Else: sRes = sEpis1Part & ""
                End Select

                Select Case Right(sEpis1Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis1Part, 1, Len(sEpis1Part) - 2) & "ка"
                End Select


            arrEpis1(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " "    ' соединяем части склоняемой должности обратно в одну строку
    End If

     If Len(sEpis2) > 0 Then    '   должность
        arrEpis2 = Split(sEpis2, "-")
        For i = LBound(arrEpis2) To UBound(arrEpis2)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis2Part = arrEpis2(i)

                Select Case Right(sEpis2Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis2Part, 1, Len(sEpis2Part)) & "а"
                    Case "ь": sRes = Mid(sEpis2Part, 1, Len(sEpis2Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis2Part, 1, Len(sEpis2Part) - 1) & "ю"
                        If UBound(arrEpis2) > 0 And i = 0 Then sRes = sEpis2Part
                    Case Else: sRes = sEpis2Part & ""
                End Select

                Select Case Right(sEpis2Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis2Part, 1, Len(sEpis2Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis2Part, 1, Len(sEpis2Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis2Part, 1, Len(sEpis2Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis2Part, 1, Len(sEpis1Part) - 2) & "ка"
            End Select

            arrEpis2(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " "  ' соединяем части склоняемой должности обратно в одну строку
    End If

     If Len(sEpis3) > 0 Then    '   должность
        arrEpis3 = Split(sEpis3, "-")
        For i = LBound(arrEpis3) To UBound(arrEpis3)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis3Part = arrEpis3(i)

                Select Case Right(sEpis3Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis3Part, 1, Len(sEpis3Part)) & "а"
                    Case "ь": sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 1) & "ю"
                        If UBound(arrEpis3) > 0 And i = 0 Then sRes = sEpis3Part
                    Case Else: sRes = sEpis3Part & ""
                End Select

                Select Case Right(sEpis3Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis3Part, 1, Len(sEpis3Part) - 2) & "ка"
                End Select

            arrEpis3(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " & Join(arrEpis3, "-") & " "  ' соединяем части склоняемой должности обратно в одну строку

    End If

    If Len(sEpis4) > 0 Then    '   должность
        arrEpis4 = Split(sEpis4, "-")
        For i = LBound(arrEpis4) To UBound(arrEpis4)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis4Part = arrEpis4(i)

                Select Case Right(sEpis4Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis4Part, 1, Len(sEpis4Part)) & "а"
                    Case "ь": sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 1) & "ю"
                        If UBound(arrEpis4) > 0 And i = 0 Then sRes = sEpis4Part
                    Case Else: sRes = sEpis4Part & ""
                End Select

                Select Case Right(sEpis4Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis4Part, 1, Len(sEpis4Part) - 2) & "ка"
                End Select

            arrEpis4(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " ' соединяем части склоняемой должности обратно в одну строку
    End If

If Len(sEpis5) > 0 Then    '   должность
        arrEpis5 = Split(sEpis5, "-")
        For i = LBound(arrEpis5) To UBound(arrEpis5)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis5Part = arrEpis5(i)

                Select Case Right(sEpis5Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis5Part, 1, Len(sEpis5Part)) & "а"
                    Case "ь": sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 1) & "ю"
                        If UBound(arrEpis5) > 0 And i = 0 Then sRes = sEpis5Part
                    Case Else: sRes = sEpis5Part & ""
                End Select

                Select Case Right(sEpis5Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis5Part, 1, Len(sEpis5Part) - 2) & "ка"
                End Select

            arrEpis5(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " ' соединяем части склоняемой должности обратно в одну строку

    End If
    If Len(sEpis6) > 0 Then    '   должность
        arrEpis6 = Split(sEpis6, "-")
        For i = LBound(arrEpis6) To UBound(arrEpis6)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis6Part = arrEpis6(i)

                Select Case Right(sEpis6Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis6Part, 1, Len(sEpis6Part)) & "а"
                    Case "ь": sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 1) & "ю"
                        If UBound(arrEpis6) > 0 And i = 0 Then sRes = sEpis6Part
                    Case Else: sRes = sEpis6Part & ""
                End Select

                Select Case Right(sEpis6Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis6Part, 1, Len(sEpis6Part) - 2) & "ка"
                End Select

            arrEpis6(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " & Join(arrEpis6, "-") & " " ' соединяем части склоняемой должности обратно в одну строку

    End If


If Len(sEpis7) > 0 Then    '   должность
        arrEpis7 = Split(sEpis7, "-")
        For i = LBound(arrEpis7) To UBound(arrEpis7)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis7Part = arrEpis7(i)

                Select Case Right(sEpis7Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis7Part, 1, Len(sEpis7Part)) & "а"
                    Case "ь": sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 1) & "ю"
                        If UBound(arrEpis7) > 0 And i = 0 Then sRes = sEpis7Part
                    Case Else: sRes = sEpis7Part & ""
                End Select

                Select Case Right(sEpis7Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis7Part, 1, Len(sEpis7Part) - 2) & "ка"
                End Select
            arrEpis7(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " _
        & Join(arrEpis6, "-") & " " & Join(arrEpis7, "-") & " " ' соединяем части склоняемой должности обратно в одну строку
    End If

    If Len(sEpis8) > 0 Then    '   должность
        arrEpis8 = Split(sEpis8, "-")
        For i = LBound(arrEpis8) To UBound(arrEpis8)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis8Part = arrEpis8(i)

                Select Case Right(sEpis8Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis8Part, 1, Len(sEpis8Part)) & "а"
                    Case "ь": sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 1) & "ю"
                        If UBound(arrEpis8) > 0 And i = 0 Then sRes = sEpis8Part
                    Case Else: sRes = sEpis8Part & ""
                End Select

                Select Case Right(sEpis8Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis8Part, 1, Len(sEpis8Part) - 2) & "ка"
                End Select
            arrEpis8(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " _
        & Join(arrEpis6, "-") & " " & Join(arrEpis7, "-") & " " & Join(arrEpis8, "-") & " " ' соединяем части склоняемой должности обратно в одну строку
    End If
If Len(sEpis9) > 0 Then    '   должность
        arrEpis9 = Split(sEpis9, "-")
        For i = LBound(arrEpis9) To UBound(arrEpis9)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis9Part = arrEpis9(i)

                Select Case Right(sEpis9Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis9Part, 1, Len(sEpis9Part)) & "а"
                    Case "ь": sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 1) & "ю"
                        If UBound(arrEpis9) > 0 And i = 0 Then sRes = sEpis9Part
                    Case Else: sRes = sEpis9Part & ""
                End Select

                Select Case Right(sEpis9Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis9Part, 1, Len(sEpis9Part) - 2) & "ка"
                End Select
            arrEpis9(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " _
        & Join(arrEpis6, "-") & " " & Join(arrEpis7, "-") & " " _
        & Join(arrEpis8, "-") & " " & Join(arrEpis9, "-") & " " ' соединяем части склоняемой должности обратно в одну строку
    End If
If Len(sEpis10) > 0 Then    '   должность
        arrEpis10 = Split(sEpis10, "-")
        For i = LBound(arrEpis10) To UBound(arrEpis10)    ' перебираем все части должностей, содержащих дефис
            sRes = "": sEpis10Part = arrEpis10(i)

                Select Case Right(sEpis10Part, 1)
                    Case "р", "к", "н", "т", "ч", "г", "д": sRes = Mid(sEpis10Part, 1, Len(sEpis10Part)) & "а"
                    Case "ь": sRes = Mid(sEpis10Part, 1, Len(sEpis10Part) - 1) & "я"
                    Case "я": sRes = Mid(sEpis10Part, 1, Len(sEpis10Part) - 1) & "ю"
                        If UBound(arrEpis10) > 0 And i = 0 Then sRes = sEpis10Part
                    Case Else: sRes = sEpis10Part & ""
                End Select

                Select Case Right(sEpis10Part, 2)    ' добавлено, для редких должностей
                    Case "ая":  sRes = Mid(sEpis10Part, 1, Len(sEpis9Part) - 2) & "ой"
                    Case "ый":  sRes = Mid(sEpis10Part, 1, Len(sEpis10Part) - 2) & "ого"
                    Case "ий":  sRes = Mid(sEpis10Part, 1, Len(sEpis10Part) - 2) & "его"
                    Case "ок":  sRes = Mid(sEpis10Part, 1, Len(sEpis10Part) - 2) & "ка"
                End Select
            arrEpis10(i) = sRes
        Next
        GenitivePostCase = Join(arrEpis1, "-") & " " & Join(arrEpis2, "-") & " " _
        & Join(arrEpis3, "-") & " " & Join(arrEpis4, "-") & " " & Join(arrEpis5, "-") & " " _
        & Join(arrEpis6, "-") & " " & Join(arrEpis7, "-") & " " _
        & Join(arrEpis8, "-") & " " & Join(arrEpis9, "-") & " " & Join(arrEpis10, "-") & " " ' соединяем части склоняемой должности обратно в одну строку
    End If


            If Len(sEpis11) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis11 & " "
    End If
            If Len(sEpis12) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis12 & " "
    End If
            If Len(sEpis13) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis13 & " "
    End If
                If Len(sEpis14) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis14 & " "
    End If
            If Len(sEpis15) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis15 & " "
    End If
                If Len(sEpis16) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis16 & " "
    End If
            If Len(sEpis17) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis17 & " "
    End If
            If Len(sEpis18) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis18 & " "
    End If
            If Len(sEpis19) > 0 Then
'                Select Case Right(sEpis1Part, 1)
            GenitivePostCase = GenitivePostCase & sEpis19 & " "
    End If



    GenitivePostCase = Replace(GenitivePostCase, "-", "- ")
    GenitivePostCase = Replace(GenitivePostCase, "- ", "-")
End Function
 
Перейти    
При выполнении двух условий - значение Х, при выполнении лишь одного условия - значение Y
 
#
30.10.2021 08:00:33
Если вдруг кому-то интересно и будет похожая задача,
то просто если условий больше одного, то их нужно заключать в скобки


Код
Sub Test()
  Dim ShSpisok As Worksheet, SpisokListObj As ListObject
  
  Set ShSpisok = ThisWorkbook.Worksheets("Лист")
  Set SpisokListObj = ShSpisok.ListObjects("Таблица_tb")
 
If SpisokListObj.DataBodyRange.Columns(2).Value = 2 _
And (SpisokListObj.DataBodyRange.Columns(3).Value > 4 _
Or SpisokListObj.DataBodyRange.Columns(4).Value > 4) Then
SpisokListObj.DataBodyRange.Columns(1).Value = "Результат № 1!"
ElseIf (SpisokListObj.DataBodyRange.Columns(3).Value > 4 _
Or SpisokListObj.DataBodyRange.Columns(4).Value > 4) Then
SpisokListObj.DataBodyRange.Columns(1).Value = "Результат № 2!"
  End If
 
   
End Sub

Всем спасибо за помощь!
Изменено: Евгений Минаков - 30.10.2021 08:04:41
 
Перейти    
При выполнении двух условий - значение Х, при выполнении лишь одного условия - значение Y
 
#
29.10.2021 01:37:52
Спасибо, vikttur, можете объяснить, что с моим кодом не так?
Изменено: Евгений Минаков - 29.10.2021 01:41:29
 
Перейти    
При выполнении двух условий - значение Х, при выполнении лишь одного условия - значение Y
 
#
29.10.2021 01:13:52
Есть таблица, в которой необходимо при значении столбца2 = 2 И столбца3 >4 ИЛИ столбца4 >4 выдать сообщение "РЕЗУЛЬТАТ № 1" (здесь все ОК)
и следующее условие: ячейка столбца2 должна быть пустой, а значения столбца3 >4 ИЛИ столбца4 >4 и при этом должно выдаваться сообщение "РЕЗУЛЬТАТ № 2",
однако когда значение столбца2 является пустым, а значение столбца3 >4, то выдается сообщение "РЕЗУЛЬТАТ № 2", а при значении столбца4 >4 выдается сообщение "РЕЗУЛЬТАТ № 1",  хотя также должно быть сообщение "РЕЗУЛЬТАТ № 2"
 
Перейти    
При выполнении двух условий - значение Х, при выполнении лишь одного условия - значение Y
 
#
29.10.2021 00:21:03
Условие заключается в том, что при выполнении двух условий одновременно принимается значение Х,
при выполнении лишь одного условия принимается значение Y

У меня проблема в том, что при выполнении двух условий одновременно все правильно отрабатывается,
а при одном условии нет
Изменено: Евгений Минаков - 29.10.2021 00:29:23
 
Перейти    
При выполнении двух условий - значение Х, при выполнении лишь одного условия - значение Y
 
#
28.10.2021 22:36:01
Здравствуйте!
Помогите пожалуйста найти ошибку в макросе.
При выполнении двух условий одновременно все работает как надо.
При добавлении Else If в третьем столбце при введении значения по условию все правильно отрабатывает, а
в четвертом столбце что-то идет не так
Код
Sub Test()
  Dim ShSpisok As Worksheet, SpisokListObj As ListObject
 
  Set ShSpisok = ThisWorkbook.Worksheets("Лист")
  Set SpisokListObj = ShSpisok.ListObjects("Таблица_tb")

If SpisokListObj.DataBodyRange.Columns(2).Value = 2 _
And SpisokListObj.DataBodyRange.Columns(3).Value > 4 _
Or SpisokListObj.DataBodyRange.Columns(4).Value > 4 Then
SpisokListObj.DataBodyRange.Columns(1).Value = "вуаля!"
Else
    If SpisokListObj.DataBodyRange.Columns(3).Value > 4 _
Or SpisokListObj.DataBodyRange.Columns(4).Value > 4 Then
SpisokListObj.DataBodyRange.Columns(1).Value = "Трям!"
  End If
  End If
  
End Sub
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
28.10.2021 22:05:38
Спасибо за помощь! Тема закрыта
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
27.10.2021 22:50:36
Все равно не понятно  :sceptic:  В любом случае, огромное спасибо! :)  
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
27.10.2021 22:22:13
New, спасибо. Почему нельзя Range использовать?
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
27.10.2021 22:07:07
Код
Sub Копировать()
   
   Dim ShSpisok As Worksheet ' Лист
   Dim SpisokListObj As ListObject

   Set ShSpisok = ThisWorkbook.Worksheets("Лист")
   Set SpisokListObj = ShSpisok.ListObjects("Таблица_tb")
   SpisokListObj.Range(1) = SpisokListObj.Range(2)

End Sub
Всем спасибо за советы. Но мне нужен примерно такой формат. Подскажите, что неправильно в коде?
Изменено: Евгений Минаков - 27.10.2021 22:21:02
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
27.10.2021 06:06:59
New, спасибо. Подскажите, пожалуйста, можно ли переделать формулу под формат R1C1?
Т.е. указывать не диапазон копирования A2:A, а просто номер столбца
Изменено: Евгений Минаков - 27.10.2021 06:17:03
 
Перейти    
Копировать столбец и перенести эти значения в другой, сохраняя значения в первом
 
#
26.10.2021 22:38:24
Всем доброго времени суток! Не смог найти подходящую тему.
Подскажите, пожалуйста, как написать макрос копирования ячеек в одной таблице.
Цель в том, чтобы копировать столбец и перенести эти значения в другой, сохраняя значения в первом.
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
08.10.2021 07:12:59
Msi2102, спасибо за помощь!
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 23:05:20
Msi2102 , прошу прощения за бестактность, но я немного переделал Ваш макрос под себя.
Подскажите, пожалуйста как исправить появление пустой строки  
Изменено: Евгений Минаков - 07.10.2021 06:50:07
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 14:11:44
Все супер.
Приносят список с фамилиями и заполняют таблицу.
После заполнения таблицы и нужно переносить внесенные данные в уже существующий список.
Только не по одной фамилии (т.к. их может быть очень много), а сразу все
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 14:01:43
Да, открывал.
Перефразирую вопрос.
Можно ли переносить строки не по одной, а все сразу?
Например кнопкой
Изменено: Евгений Минаков - 06.10.2021 14:03:14
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 13:27:52
Msi2102, спасибо за ответ.
Только задача состоит в том, что в пустую таблицу вносятся новые сотрудники,
а после того как внесутся необходимые данные, они переносятся на другой лист,
при этом первая таблица должна очистится. Это как-то можно реализовать?
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 06:41:54
Написал макрос для удаления строк, но почему-то ничего не удаляет.
Подскажите, пожалуйста что не так
Изменено: Евгений Минаков - 06.10.2021 07:10:50
 
Перейти    
Перенос строк/удаление строк после переноса
 
#
06.10.2021 06:26:51
Здравствуйте, уважаемые форумчане! Подскажите, пожалуйста решить задачку.
Необходимо из одной таблицы перенести строки в другую с сохранением значений.
После переноса значений из первой таблицы необходимо удалить строки.
 
Перейти    
Удаление строк на основании списка значений (множественные критерии)
 
#
05.10.2021 06:57:02
Здравствуйте, уважаемые форумчане! Подскажите, пожалуйста решить задачку.
Необходимо из одной таблицы перенести строки в другую с сохранением значений.
После переноса значений из первой таблицы необходимо удалить строки.
 
Перейти    
ФИО в инициалы макросом, ФИО (отчества может не быть) преобразовать в инициалы макросом
 
#
03.10.2021 10:38:49
Nordheim, спасибо!
 
Перейти    
ФИО в инициалы макросом, ФИО (отчества может не быть) преобразовать в инициалы макросом
 
#
01.10.2021 07:11:40
Здравствуйте, уважаемые форумчане! Прошу прощения за назойливость. В общем у меня получилось то, что я планировал, за исключением того, что если вызывать макрос кнопкой с другого листа, то значения не вставляются в исходную таблицу. Подскажите, пожалуйста, что необходимо исправить?
 
Перейти    
ФИО в инициалы макросом, ФИО (отчества может не быть) преобразовать в инициалы макросом
 
#
30.09.2021 13:22:07
Мне как раз без выделения нужно, чтобы автоматом добавлял при внесения значения в ячейку😐
Изменено: Евгений Минаков - 30.09.2021 13:22:56
 
Перейти    
Страницы: 1 2 След.
Наверх