Определение таблицы по ее обрисованным границам.

Автор GWolf, 25.10.2018, 09:00

« назад - далее »

GWolf

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

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

boa

Добрый день, 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

Спасибо, уважаемый 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
Путей к вершине - множество. Этот один из многих!