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

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


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

Новости:

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

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

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

GWolf

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

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

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

boa

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

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



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

09.08.2019 14:09 Макрос для заполнения таблиц через форму 116
18.07.2019 16:02 Рассылка почты из Excel при помощи почтовой программы TheBAT! 150
09.07.2019 20:39 Кредит с уменьшением периода выплат 169
28.05.2019 21:09 Сделать несколько скриптов для рабочей таблицы 498
05.03.2019 17:00 Последовательный вывод таблиц Excel в один документ Word без шаблона 805
05.03.2019 09:29 Нежелательные изменение размеров колонтитула при редактировании 582
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 717
20.01.2019 12:38 Все варианты частичного суммирования 880
13.01.2019 12:24 Заполнение диапазона числами - в виде кластеров 729
30.09.2018 10:24 Расчет процентов за определенный период (месяц) с учетом изменений и платежей 1146





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

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