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

Вход

Регистрация

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

 

= Мир MS Excel/Игнорирование пробелов в строке координат для линии. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Игнорирование пробелов в строке координат для линии. (Макросы/Sub)
Игнорирование пробелов в строке координат для линии.
Димитрий Дата: Четверг, 03.05.2018, 23:40 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуй народ.
Появился вопрос по вба.

У меня есть макрос, который рисует линии, чьи координаты записаны в одну строчку.
Если макрос встречает пробел в этой строчке - то он понимает это так, что последний отрезок полилинии нарисован и нужно начинать чертить отрезок новой полилинии.

Как научить этот макрос - игнорировать пробелы и считать все координаты что записаны в строку - координатами узлов единой полилинии, чтобы получилась одна-единственная линия (а не несколько отдельных линий) ?
К сообщению приложен файл: 2106990.rar(97.2 Kb)
 
Ответить
СообщениеЗдравствуй народ.
Появился вопрос по вба.

У меня есть макрос, который рисует линии, чьи координаты записаны в одну строчку.
Если макрос встречает пробел в этой строчке - то он понимает это так, что последний отрезок полилинии нарисован и нужно начинать чертить отрезок новой полилинии.

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

Автор - Димитрий
Дата добавления - 03.05.2018 в 23:40
K-SerJC Дата: Пятница, 04.05.2018, 09:03 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 359
Репутация: 52 ±
Замечаний: 0% ±

Excel 2013
так?
[vba]
Код
Sub run_1()
    Dim i&, k&, j&, lc
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
    lc = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    For j = k To lc
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To lc
              If Not IsEmpty(b(1, i)) Then .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                Next i
            .ConvertToShape
            End With
    End If
[/vba]
End Sub
К сообщению приложен файл: 7861380.rar(98.9 Kb)


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщениетак?
[vba]
Код
Sub run_1()
    Dim i&, k&, j&, lc
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
    lc = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    For j = k To lc
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To lc
              If Not IsEmpty(b(1, i)) Then .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                Next i
            .ConvertToShape
            End With
    End If
[/vba]
End Sub

Автор - K-SerJC
Дата добавления - 04.05.2018 в 09:03
sboy Дата: Пятница, 04.05.2018, 09:08 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2014
Репутация: 576 ±
Замечаний: 0% ±

Excel 2010
Еще вариант
[vba]
Код
Sub Âàðèàíò_1()
    Dim i&, k&, j&
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
Nach:
    For j = k To UBound(b, 2)
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To UBound(b, 2)
                .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                If i = UBound(b, 2) Then Exit For
                Do While IsEmpty(b(1, i + 1))
                    k = i + 1
                    i = i + 1
                Loop
            Next
            .ConvertToShape
            'If k < UBound(b, 2) Then GoTo Nach
        End With
    End If
End Sub
[/vba]
 
Ответить
СообщениеЕще вариант
[vba]
Код
Sub Âàðèàíò_1()
    Dim i&, k&, j&
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
Nach:
    For j = k To UBound(b, 2)
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To UBound(b, 2)
                .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                If i = UBound(b, 2) Then Exit For
                Do While IsEmpty(b(1, i + 1))
                    k = i + 1
                    i = i + 1
                Loop
            Next
            .ConvertToShape
            'If k < UBound(b, 2) Then GoTo Nach
        End With
    End If
End Sub
[/vba]

Автор - sboy
Дата добавления - 04.05.2018 в 09:08
Димитрий Дата: Суббота, 05.05.2018, 15:39 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо.
Оба варианта - работают.
 
Ответить
СообщениеСпасибо.
Оба варианта - работают.

Автор - Димитрий
Дата добавления - 05.05.2018 в 15:39
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Игнорирование пробелов в строке координат для линии. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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