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

Вход

Регистрация

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

 

= Мир MS Excel/Увеличение-уменьшение области чисел - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Увеличение-уменьшение области чисел (Макросы/Sub)
Увеличение-уменьшение области чисел
КошкаСофи Дата: Четверг, 09.05.2019, 17:01 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день.

У меня появился вопрос про увеличение-уменьшение области чисел.
В книге есть ячейка S16, в ней находится число "4".

Как вокруг этой ячейки симметрично расставить определенное количество чисел?

Иными словами - если это одна ячейка, а вокруг - пустые ячейки. То вокруг S16 - расставятся числа "4", в том количестве какое требуется чтобы полностью окружить эту ячейку, но не больше числа указанного в ячейке H4.
Но если вокруг S16 - уже стоят какие-то число - то нужно симметрично расставить вокруг этой области - еще 11 цифр-четверок.

Адрес ячейки указан в H3.
Число цифр указано в H4.

То есть - чем больше щелчков по кнопке - тем больше будет становится область.
К сообщению приложен файл: 547547.xls (30.5 Kb)
 
Ответить
СообщениеДобрый день.

У меня появился вопрос про увеличение-уменьшение области чисел.
В книге есть ячейка S16, в ней находится число "4".

Как вокруг этой ячейки симметрично расставить определенное количество чисел?

Иными словами - если это одна ячейка, а вокруг - пустые ячейки. То вокруг S16 - расставятся числа "4", в том количестве какое требуется чтобы полностью окружить эту ячейку, но не больше числа указанного в ячейке H4.
Но если вокруг S16 - уже стоят какие-то число - то нужно симметрично расставить вокруг этой области - еще 11 цифр-четверок.

Адрес ячейки указан в H3.
Число цифр указано в H4.

То есть - чем больше щелчков по кнопке - тем больше будет становится область.

Автор - КошкаСофи
Дата добавления - 09.05.2019 в 17:01
КошкаСофи Дата: Пятница, 10.05.2019, 19:44 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Имеется вот такой код:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long, c As Long, v As Long, i As Long
    
    If Target.CountLarge <> 1 Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo Error_exit

    r = Target.Row
    c = Target.Column
    v = Val(Target.Value)
    For i = v - 1 To 0 Step -1
        Range(Cells(WorksheetFunction.Max(r - i, 1), WorksheetFunction.Max(c - i, 1)), _
            Cells(WorksheetFunction.Min(r + i, Rows.Count), WorksheetFunction.Min(c + i, Columns.Count))).Value = v - i
    Next i

Error_exit:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
[/vba]
Этот код при появлении какого-то числа на листе - окружает его числами по периметру ячейки.

В моем вопросе - тоже нужно как-то окружать область вокруг ячейки, но не полностью по всему периметру, а добавлять фиксированное количество чисел по периметру.
То есть это будет выглядеть как область с неровными краями, а не как квадрат.

Подскажите - как это сделать ?
К сообщению приложен файл: 791.xls (48.0 Kb)


Сообщение отредактировал КошкаСофи - Пятница, 10.05.2019, 19:45
 
Ответить
СообщениеИмеется вот такой код:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long, c As Long, v As Long, i As Long
    
    If Target.CountLarge <> 1 Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo Error_exit

    r = Target.Row
    c = Target.Column
    v = Val(Target.Value)
    For i = v - 1 To 0 Step -1
        Range(Cells(WorksheetFunction.Max(r - i, 1), WorksheetFunction.Max(c - i, 1)), _
            Cells(WorksheetFunction.Min(r + i, Rows.Count), WorksheetFunction.Min(c + i, Columns.Count))).Value = v - i
    Next i

Error_exit:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
[/vba]
Этот код при появлении какого-то числа на листе - окружает его числами по периметру ячейки.

В моем вопросе - тоже нужно как-то окружать область вокруг ячейки, но не полностью по всему периметру, а добавлять фиксированное количество чисел по периметру.
То есть это будет выглядеть как область с неровными краями, а не как квадрат.

Подскажите - как это сделать ?

Автор - КошкаСофи
Дата добавления - 10.05.2019 в 19:44
КошкаСофи Дата: Понедельник, 13.05.2019, 21:25 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Кто-нибудь знает как решить такую задачу ?
Хотя бы примерно.
 
Ответить
СообщениеКто-нибудь знает как решить такую задачу ?
Хотя бы примерно.

Автор - КошкаСофи
Дата добавления - 13.05.2019 в 21:25
RAN Дата: Понедельник, 13.05.2019, 22:29 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Мяу
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iOffs&, iCol&, x&, i&, r As Range
    If Target.CountLarge <> 1 Then Exit Sub
    If Len(Target) = 0 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    On Error GoTo End_
    x = Target.Value
    iOffs = 1
    Application.EnableEvents = False
    Do
        Set r = Target.Offset(-iOffs, -iOffs).Resize(iOffs * 2 + 1, iOffs * 2 + 1)
        iCol = r.Columns.Count
        r(1) = x    'Target - 1
        For i = 1 To iCol
            r(1, i) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = 2 To iCol
            r(i, iCol) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = iCol - 1 To 1 Step -1
            r(iCol, i) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = iCol - 1 To 2 Step -1
            r(i, 1) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        iOffs = iOffs + 1
        DoEvents
    Loop
End_:
    Application.EnableEvents = True
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеМяу
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iOffs&, iCol&, x&, i&, r As Range
    If Target.CountLarge <> 1 Then Exit Sub
    If Len(Target) = 0 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    On Error GoTo End_
    x = Target.Value
    iOffs = 1
    Application.EnableEvents = False
    Do
        Set r = Target.Offset(-iOffs, -iOffs).Resize(iOffs * 2 + 1, iOffs * 2 + 1)
        iCol = r.Columns.Count
        r(1) = x    'Target - 1
        For i = 1 To iCol
            r(1, i) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = 2 To iCol
            r(i, iCol) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = iCol - 1 To 1 Step -1
            r(iCol, i) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        For i = iCol - 1 To 2 Step -1
            r(i, 1) = x
            x = x - 1
            If x < 0 Then GoTo End_
        Next
        iOffs = iOffs + 1
        DoEvents
    Loop
End_:
    Application.EnableEvents = True
End Sub
[/vba]

Автор - RAN
Дата добавления - 13.05.2019 в 22:29
КошкаСофи Дата: Понедельник, 13.05.2019, 23:16 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
RAN, понятно.
Спасибо.
Буду разбираться.
 
Ответить
СообщениеRAN, понятно.
Спасибо.
Буду разбираться.

Автор - КошкаСофи
Дата добавления - 13.05.2019 в 23:16
КошкаСофи Дата: Пятница, 17.05.2019, 10:01 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
RAN, скажите пожалуйста - у вас в макросе числа которые расставляются вокруг ячейки S16 - неидентичны тому числу, которое стоит в самой ячейке S16.
То есть - если в ячейке S16 стоит цифра 8, то вокруг нее должны появиться 10 чисел (как написано в H4), со значениями 8.

Что можно поменять в макросе, что он расставлял именно одинаковые числа в заданном (в ячейке H4) количестве - вокруг S16 ?
Как вы считаете ?
К сообщению приложен файл: 547547_.xls (54.0 Kb)
 
Ответить
СообщениеRAN, скажите пожалуйста - у вас в макросе числа которые расставляются вокруг ячейки S16 - неидентичны тому числу, которое стоит в самой ячейке S16.
То есть - если в ячейке S16 стоит цифра 8, то вокруг нее должны появиться 10 чисел (как написано в H4), со значениями 8.

Что можно поменять в макросе, что он расставлял именно одинаковые числа в заданном (в ячейке H4) количестве - вокруг S16 ?
Как вы считаете ?

Автор - КошкаСофи
Дата добавления - 17.05.2019 в 10:01
КошкаСофи Дата: Пятница, 24.05.2019, 15:12 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Помогите, пожалуйста.
 
Ответить
СообщениеПомогите, пожалуйста.

Автор - КошкаСофи
Дата добавления - 24.05.2019 в 15:12
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Увеличение-уменьшение области чисел (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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