Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Пакет Microsoft Office

  Все выпуски  

RFpro.ru: Пакет Microsoft Office


РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты в разделе

CradleA
Статус: Мастер-Эксперт
Рейтинг: 278
∙ повысить рейтинг »
Megaloman
Статус: Мастер-Эксперт
Рейтинг: 210
∙ повысить рейтинг »
solowey
Статус: Профессор
Рейтинг: 83
∙ повысить рейтинг »

Пакет MSOffice

Номер выпуска:1036
Дата выхода:09.06.2021, 22:45
Администратор рассылки:Megaloman (Мастер-Эксперт)
Подписчиков / экспертов:3 / 29
Вопросов / ответов:4 / 5

Консультация # 201083: Здравствуйте! Прошу помощи в следующем вопросе: Открыть файл на запись. Записать в него 150 различных чисел. Закрыть файл. Открыть файл на чтение и, прочитав записанные данные, получить новый массив, содержащий введённые числа в следующем порядке: 1-ое число поменять со 150-м, 2-ое со 149-м и т.д. 1-ое число получившегося массива поменять ...
Консультация # 201084: Уважаемые эксперты! Пожалуйста, ответьте на вопрос: Во введенном с клавиатуры предложении поменять порядок слов на обратный, т.е. первое слово поменять с последним, второе - с предпоследним и так до среднего слова. (На языке VBA) Огромное спасибо!! ...
Консультация # 201085: Уважаемые эксперты! Пожалуй ста, ответьте на вопрос: Написать логическую функцию, принимающую значения True, если в целом числе, являющимся единственным аргументом этой функции, сумма цифр – простое число. (На языке VBA) Огромное спасибо!!!...
Консультация # 201086: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: Подсчитать сколько точек плоскости, координаты которых вводятся с первых двух столбцов рабочего листа, находятся вне квадрата 0<=x<=1 и 0<=y<=1. Для описания координат точек использовать переменную пользовательского типа. Для проверки принадлежности точки указа...

Консультация # 201083:

Здравствуйте! Прошу помощи в следующем вопросе:
Открыть файл на запись. Записать в него 150 различных чисел. Закрыть файл. Открыть файл на чтение и, прочитав записанные данные, получить новый массив, содержащий введённые числа в следующем порядке:
1-ое число поменять со 150-м, 2-ое со 149-м и т.д.
1-ое число получившегося массива поменять с 75-м, 2-ое с 74-м и т.д., то же самое проделать и со второй половиной. (На языке VBA)
Огромное спасибо!

Дата отправки: 04.06.2021, 19:47
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):

Код
Sub WriteRead()

Const File1 = "Z:\Box_Out\Файл с исходными числами.txt"
Const File2 = "Z:\Box_Out\Файл с переставленными числами.txt"
Const N = 150
Const i11 = 1, i12 = 150
Const i21 = 1, i22 = 75
Const i31 = 76, i32 = 150


With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(File1, True)           ' Записываем в файл исходные числа
        Randomize
        For i = 1 To N
            .WriteLine CStr(i)
            '.WriteLine CStr(Int((1000 - 100 + 1) * Rnd + 100))
        Next
        .Close
    End With
    
    With .OpenTextFile(File1, 1, False)         ' Читаем из файла исходные числа
        Sall = .ReadAll
        .Close
    End With
    
    If Right(Sall, 2) = vbCrLf Then
        Sall = Mid(Trim(Sall), 1, Len(Sall) - 2)
    End If
    
    Mass = Split(Sall, vbCrLf)
    i1 = LBound(Mass)
    i2 = UBound(Mass)
    
    Call MyMove(Mass, i1, i11, i12)
    Call MyMove(Mass, i1, i21, i22)
    Call MyMove(Mass, i1, i31, i32)
    
    With .CreateTextFile(File2, True)           ' Записываем в файл преобразованный массив чисел
        For i = i1 To i2
            .WriteLine Mass(i)
        Next
        .Close
    End With
End With

End Sub

Sub MyMove(Mass, i1, j1, j2)
    jj = CInt((j2 - j1) / 2) + 1
    If jj > 1 Then
        For j = 1 To jj
            m = Mass(j1 + j - 2 + i1)
            Mass(j1 + j - 2 + i1) = Mass(j2 - j + i1)
            Mass(j2 - j + i1) = m
        Next
    End If
End Sub

Ответ отредактирован модератором Megaloman (Мастер-Эксперт) 05.06.2021, 11:15

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 05.06.2021, 11:09 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 05.06.2021, 11:20

Рейтинг ответа:

НЕ одобряю 0 одобряю!

Консультация # 201084:

Уважаемые эксперты! Пожалуйста, ответьте на вопрос:
Во введенном с клавиатуры предложении поменять порядок слов на обратный, т.е. первое слово поменять с последним, второе - с предпоследним и так до среднего слова.
(На языке VBA)
Огромное спасибо!!

Дата отправки: 04.06.2021, 19:48
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 2
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):

Код
Sub Words()

S0 = ""
S0 = Trim(InputBox("Введите предложение"))

If S0 = "" Then
    MsgBox "Предложение не введено"
Else
    N = Len(S0)
    Do
        S0 = Replace(S0, "  ", " ")
        N1 = Len(S0)
        If N1 = N Then Exit Do
        N = N1
    Loop

    Mass = Split(S0, " ")
    i1 = LBound(Mass)
    i2 = UBound(Mass)

    If i1 = i2 Then
        S = S0
    Else
        N = CInt((i2 - i1 + 1) / 2) - 1
        For i = 0 To N
            S = Mass(i1 + i)
            Mass(i1 + i) = Mass(i2 - i)
            Mass(i2 - i) = S
        Next
    
        S = Mass(i1)
        For i = i1 + 1 To i2
            S = S + " " + Mass(i)
        Next
    End If
    MsgBox S0 + vbCrLf + vbCrLf + S
End If

End Sub

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 05.06.2021, 00:36 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 05.06.2021, 11:21

Рейтинг ответа:

НЕ одобряю 0 одобряю!


Консультирует solowey (Профессор):

Добрый день.
Вот пример решения:

Код
Sub Макрос1()
    Dim text As String, result As String, count As Integer, temp As String
    Dim arr
    text = Лист1.Range("B1")
    arr = Split(text, " ")
    
    count = UBound(arr)
    For i = 0 To count / 2
        temp = arr(i)
        arr(i) = arr(count - i)
        arr(count - i) = temp
    Next
    result = Join(arr, " ")
    Лист1.Range("B3") = result
End Sub

Консультировал: solowey (Профессор)
Дата отправки: 07.06.2021, 21:41
Рейтинг ответа:

НЕ одобряю 0 одобряю!

Консультация # 201085:

Уважаемые эксперты! Пожалуйста, ответьте на вопрос:

Написать логическую функцию, принимающую значения True, если в целом числе, являющимся единственным аргументом этой функции, сумма цифр – простое число.
(На языке VBA)
Огромное спасибо!!!

Дата отправки: 04.06.2021, 19:49
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):

vba

Код
Sub SubSimp()

N = InputBox("Введите целое N>0")

ierr = False
If IsNumeric(N) Then
    CN = CDbl(N)
    ierr = CDbl(CN) > 0 And Int(CN) = CN
End If

If Not ierr Then
    MsgBox "Введено неверное число" + vbCrLf + N
    Exit Sub
End If

If FunSimp(N) Then
    MsgBox "Сумма цифр в числе" + vbCrLf + vbCrLf + CStr(N) + vbCrLf + vbCrLf + "простое число"
Else
    MsgBox "Сумма цифр в числе" + vbCrLf + vbCrLf + CStr(N) + vbCrLf + vbCrLf + "НЕ простое число"
End If

End Sub
Function FunSimp(N)
    S = CStr(N)
    k = Len(S)
    SS = 0
    For i = 1 To k
        SS = SS + CInt(Mid(S, i, 1))
    Next
    FunSimp = True
    If SS > 3 Then
        For i = 2 To SS - 1
            FunSimp = (SS Mod i <> 0)
            If Not FunSimp Then Exit Function
        Next
    End If
End Function

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 04.06.2021, 23:13 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 05.06.2021, 11:22

Рейтинг ответа:

НЕ одобряю 0 одобряю!

Консультация # 201086:

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Подсчитать сколько точек плоскости, координаты которых вводятся с первых двух столбцов рабочего листа, находятся вне квадрата 0<=x<=1 и 0<=y<=1. Для описания координат точек использовать переменную пользовательского типа. Для проверки принадлежности точки указанной области использовать логическую функцию.
(На языке VBA)
Огромное спасибо!!!

Дата отправки: 04.06.2021, 19:49
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):

Код
Type Koord
    x As Double
    y As Double
End Type
Sub rrr()
'    Const R1 = "A1"
    Const R1 = "C5"
    Const x1 = 0, x2 = 1
    Const y1 = 0, y2 = 1

    R2 = Range(R1).End(xlDown).Offset(0, 1).Address
    N = Range(R2).Row - Range(R1).Row + 1
    
    If Len(Trim(CStr(Range(R1)))) = 0 Or Len(Trim(CStr(Range(R2)))) = 0 Then
        MsgBox "В ячейке " + R1 + " или " + R2 + " нет координат"
        Exit Sub
    End If
    
    ReDim Points(1 To N) As Koord

    For i = 1 To N
        Points(i).x = Range(R1).Offset(i - 1, 0)
        Points(i).y = Range(R1).Offset(i - 1, 1)
    Next

    M = 0
    For i = 1 To N
        If Square(Points(i), x1, x2, y1, y2) Then M = M + 1
    Next
    MsgBox "Число точек с координатами:" + vbCrLf + vbCrLf + "0<=x<=1    0<=y<=1" + vbCrLf + vbCrLf + "равно " + CStr(M)
End Sub

Function Square(P As Koord, x1, x2, y1, y2)
    Square = (x1 <= P.x And P.x <= x2 And y1 <= P.y And P.y <= y2)
End Function

Ответ отредактирован модератором Megaloman (Мастер-Эксперт) 05.06.2021, 16:16

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 05.06.2021, 15:33 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 05.06.2021, 16:20

Рейтинг ответа:

НЕ одобряю 0 одобряю!


Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!


В избранное