Профессиональные приемы работы в Microsoft Excel

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Автор Тема: Определение таблицы по ее обрисованным границам.  (Прочитано 184 раз)

0 Пользователей и 1 Гость просматривают эту тему.

GWolf

  • Старожил
  • ****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 938

Доброго времени суток, друзья!

На множестве листов (в примере их три) размещается табличка имеющая название "Таблица 1". Ее положение на каждом конкретном листе может быть отлично от ее расположения на других листах, но границы таблицы всегда начинаются на строку ниже, ячейки, в которой записано "Таблица 1" и в той же колонке. Сама таблица имеет разное количество объединенных ячеек по столбцам.
Поэтому есть мысль определить размерности таблицы по ее отрисованным границам. Но, вот как это сделать?
Помогите, пожалуйста!
Записан
Путей к вершине - множество. Этот один из многих!

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 580
  • Доброта спасет мир...

Добрый день, GWolf
макрос в окне Immediate впечатает адреса таблиц
Option Explicit

Sub NewMacros()
'' Author:  boa
'' Written: 25.10.2018
'' Edited:
'  Description:

    Dim Start!:           Start = Timer

Dim a As Range, iOfC&, iOfR, FirstValue$

With ActiveSheet
on error resume next
    Set a = .Cells.Find("таблица", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart)
    If a Is Nothing Then Exit Sub
    FirstValue = a.Value
    Do
        iOfC = 0
        Do
          If Not a.Offset(1, iOfC).Borders(xlEdgeRight).LineStyle = xlContinuous Then Exit Do
          iOfC = iOfC + 1
        Loop
       
        iOfR = 1
        Do
          If Not a.Offset(iOfR, 0).Borders(xlEdgeLeft).LineStyle = xlContinuous Then Exit Do
          iOfR = iOfR + 1
        Loop
       
        Debug.Print a.Value & ": " & Range(a.Offset(1, 0), a.Offset(iOfR - 1, iOfC - 1)).Address
       
        Set a = .Cells.FindNext(After:=a)
        If a.Value = FirstValue Then Exit Do
    Loop
   
End With
   
    Debug.Print "Затрачено: " & Timer - Start
End Sub
Но что бы границы правильно определялись, не должно быть "не заданных" границ(см.вложение jpg).
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

GWolf

  • Старожил
  • ****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 938

Спасибо, уважаемый boa!
Все работает. Теперь буду "прикручивать" к своим нуждам.
А то я тут попытался решить проблему на моем уровне понимания, получилось координаты определить, но если в соседней, за таблицей, ячейке будет чего нибудь "забито", то все координаты летят!

Делал так:
Sub Стрелкавниз1_Щелчок()
    'предустановка значений таблицы 1, листа "SpisZn" в таблицах 1 листов
    Dim Sh As Worksheet
    Dim tPoint As Object
    Dim adrs As String
    Dim objR As Range
   
    With ThisWorkbook
        With .Worksheets("SpisZn")
        End With
       
        sct = .Worksheets.Count
       
        For Each Sh In .Worksheets
            'Sh.Cells(1, 1).Value = 1
            With Sh
                If .Name <> "SpisZn" And .Name <> "РАСЧЕТНАЯ ФОРМА" Then
                    Set tPoint = .Cells.Find("Таблица 1")
                   
                    If tPoint Is Nothing Then
                        adrs = "Нет такого заголовка на листе!"
                    Else
                        adrs = tPoint.Address
                    End If
                    Set tPoint = Nothing
                   
                    .Activate
                   
                    MsgBox "Лист № " & .Index & " (имя листа: " & .Name & ") из " & sct & " лист (-а, -ов)." & Chr(10) & "Адрес заголовка Таблица 1: " & adrs, , "Ищем адрес заголовка Таблица 1, на листах"

                    'выделение Таблицы 1
                    Set objR = .Range(adrs).Offset(1, 0)
                   
                    nRIn = objR.Row
                    nCIn = objR.Column

                    Set objR = objR.End(xlToRight)
                    Set objR = objR.End(xlDown)
                   
                    nRTo = objR.Row
                    nCTo = objR.Column

                    Set objR = Range(.Cells(nRIn, nCIn), .Cells(nRTo, nCTo))
                    objR.Select
                End If
            End With
        Next
    End With
End Sub
Записан
Путей к вершине - множество. Этот один из многих!
 



Темы без ответов

28.05.2019 21:09 Сделать несколько скриптов для рабочей таблицы 157
05.03.2019 17:00 Последовательный вывод таблиц Excel в один документ Word без шаблона 527
05.03.2019 09:29 Нежелательные изменение размеров колонтитула при редактировании 369
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 494
20.01.2019 12:38 Все варианты частичного суммирования 644
13.01.2019 12:24 Заполнение диапазона числами - в виде кластеров 503
30.09.2018 10:24 Расчет процентов за определенный период (месяц) с учетом изменений и платежей 945
03.03.2018 00:00 Подсчет отработанного времени, за исключением заранее определенных перерывов 1735
14.02.2018 10:11 Подготовить читабельную отчетность по платежам 1774
23.01.2018 13:46 Найти вероятность повторной покупки 1586





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.115 секунд. Запросов: 105.