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