Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.03.2022, 21:48   #1
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию Сравнение шапок

Здравствуйте, уважаемые гуру!
Есть такая задача - сравнить два диапазона Excel.
Нужно, чтобы макрос сравнивал, именно выделенный диапазон.
Всем буду очень признателен за ответ!
Вложения
Тип файла: xlsx сравнение шапок 2листов.xlsx (11.3 Кб, 6 просмотров)
vasa11 вне форума Ответить с цитированием
Старый 16.03.2022, 08:50   #2
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

vasa11
Какие диапазоны нужно сравнивать?
Где выделенные диапазоны?
Что конкретно значит "сравнить"?

Предлагаю код, который сравнивает два диапазона на полное совпадение данных.
Код:
Sub CompareRanges()
    Dim x As Range, y As Range
    Set x = [A1:A10] 'Диапазон 1
    Set y = [B1:B10] 'Диапазон 2
    If Evaluate("AND(" & x.Address & "=" & y.Address & ")") Then
        'Действия, если данные в диапазонах совпадают
    Else
        'Действия, если данные в диапазонах не совпадают
    End If
End Sub
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 16.03.2022, 11:43   #3
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию

Диапазон выбирается любой через Application.InputBox
Sub CompareBooks()
Dim xWb As Workbook
Dim xAddWb As Workbook
Dim xRng1 As Range
Dim xRng2 As Range
Set xWb = Application.ActiveWorkbook
xTitleId = "Выбор файлов для обработки"
With Application.FileDialog(msoFileDialo gOpen)
.Filters.Clear
.Filters.Add "Excel 2007-19", "*.xlsx; *.xlsm; *.xls; *.xlsa"
.AllowMultiSelect = False
.ButtonName = "OK"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Application.Workbooks.Open .SelectedItems(1)
Set xAddWb = Application.ActiveWorkbook
On Error Resume Next
Set xRng1 = Application.InputBox(Prompt:=" Выберите наименование строк можно мышкой или написать диапазон для обработки ", Title:=xTitleId, Default:="", Type:=8)
MsgBox " выбран диапазон" & xRng1.Address

If xRng1 Is Nothing Then
MsgBox "Отмена выполнения", vbCritical, "Нет данных"
Exit Sub
End If
Application.ScreenUpdating = False
End With
'Проверка,сравнение названий/расположения выбранного диапазона с диапазоном листа шапка
Header

End Sub

Sub Header()
Dim dpn, wsL As Worksheet, rc As Range
dpn = "c4:H4" 'адрес эталонной шапки
Set wsL = ThisWorkbook.Sheets("шапка") 'лист с эталонной шапкой, может быть скрытым
For Each rc In wsL.Range(dpn).Cells
' rc.Value строка и столбец Sheets("шапка")
' ActiveSheet.Cells(rc.Row, rc.Column) строка и столбец активной книги,с которой сравниваем
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>
'сейчас проверяется строка 4 и столбцы 3 по 6 активной книги, а надо чтобы проверялся выделеный диапазон xRng1.Address
If rc.Value <> ActiveSheet.Cells(rc.Row, rc.Column).Value Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>
MsgBox " столбец шапки выбраного документа не совпадает с образцом! " & rc.Value & vbNewLine & "Для дальнейшей работы необходимо форматировать импортную таблицу чтобы шапка соответствовала шаблону", vbInformation, "проверка шапки на совпадение с образцом"
Exit Sub
End If
Next
MsgBox " шапки документов совпадает", vbInformation, "Проверка"
End Sub
у меня не присоединился макросы поэтому выкладываю отдельно

Последний раз редактировалось vasa11; 16.03.2022 в 11:51. Причина: добавка
vasa11 вне форума Ответить с цитированием
Старый 17.03.2022, 07:37   #4
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Файлы, содержащие макросы, требуется прикреплять в архиве.
Посмотрите пример во вложении.
Лист с шаблоном "шапки" скрыт.
Сама "шапка" может содержать произвольное количество строк и столбцов (в примере это диапазон "C4:H4").
Если в выделенном диапазоне "шапки" для сравнения количество строк или столбцов не соответствует шаблону, то макрос выдаст соответствующее предупреждение.
Проверяйте. Все ли так, как Вам нужно?
Вложения
Тип файла: rar Пример.rar (18.0 Кб, 4 просмотров)
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 17.03.2022 в 07:54.
SAS888 вне форума Ответить с цитированием
Старый 17.03.2022, 12:24   #5
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию

Спасибо.Макрос отлично справляется с задачей.
Но по сколько "шапка" может содержать произвольное количество строк и столбцов,что несомненно большой плюс,то напрашивается вопрос? Как изменить Set x = ThisWorkbook.Sheets("шапка").Range( "C4:H4") 'диапазон эталонной шапки ,в редакторе не открывая его ведь не каждый пользователь знает VBA чтобы изменить эту строку.Может через отдельную форму задать диапазон?
vasa11 вне форума Ответить с цитированием
Старый 17.03.2022, 15:44   #6
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
  Set x = Application.InputBox("Отметьте мышью нужный диапазон", Type:=8)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 17.03.2022, 19:56   #7
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию

Спасибо.Но если добавить конструкцию т.е. задействовать кнопку отмена:
Dim x As Range
Set x = Application.InputBox("Отметьте мышью нужный диапазон", Type:=8)
If Err <> 0 Then
MsgBox "Отмена выполнения", vbCritical, "Нет данных": Exit Sub
End If
не работает.
vasa11 вне форума Ответить с цитированием
Старый 17.03.2022, 20:14   #8
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию

виноват забыл вставить On Error Resume Next
Файл рабочий,помощь оказана.Благодарю всех за оказанное внимание.
vasa11 вне форума Ответить с цитированием
Старый 20.03.2022, 07:28   #9
vasa11
Пользователь
 
Регистрация: 15.02.2012
Сообщений: 13
По умолчанию

SAS888
Подскажите,пожалуйста,как объединить 2 макроса CompareBooks и Sub Header(y As Range) в один макрос
vasa11 вне форума Ответить с цитированием
Старый 21.03.2022, 04:40   #10
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Пример во вложении.
Вложения
Тип файла: rar Пример_2.rar (16.9 Кб, 6 просмотров)
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Иерархическая структура шапок Olesya9771 Фриланс 1 08.12.2017 10:13
Печать разных шапок на листах Artistry Microsoft Office Excel 2 11.04.2014 13:34
скільки шапок вказаних розмірів можна пошити з хутра вказаних розмірів Соні C# (си шарп) 3 25.09.2013 20:15
Сравнение SeMgA Общие вопросы Delphi 4 08.05.2012 17:29
сравнение slavsmo Microsoft Office Excel 2 05.04.2010 17:51