Сначала я идентифицирую некоторые ошибки и плохие практики в вашем коде, а затем обдумываю, как переработать макрос для достижения ваших целей.
Выпуск 1
Основная цельиз On Error, чтобы позволить вам аккуратно завершить работу в случае непредвиденной ошибки.Вы не должны использовать его, чтобы избежать ожидаемых ошибок и не должны игнорировать ошибки.
Рассмотрите функции LastRow и LastCol.В обоих случаях, если поиск не удался, вы игнорируете ошибку и продолжаете.Но это означает, что эти функции возвращают неверное значение, поэтому вы получаете еще одну ошибку в вызывающей подпрограмме.Если поиск не удастся, вы должны расследовать, а не игнорировать.Это верно для любой другой ошибки.
Выпуск 2
Поиск не возвращает ничего, если лист пустой.Вы вызываете функции LastRow и LastCol для рабочего листа "RDBMergeSheet", когда он пуст.Код должен быть:
Set Rng = sh.Cells.Find( ...)
If Rng Is Nothing Then
' Sheet sh is empty
LastRow = 0
Else
LastRow = Rng.Row
End If
Здесь я установил LastRow равным 0, если рабочая таблица пуста.Это перестает быть побочным эффектом ошибки, но задокументирована особенность функции: «Возвращаемое значение = 0 означает, что лист пуст».Вызывающая процедура должна проверить это значение и пропустить все пустые листы.Существуют и другие подходы, но ключевой момент заключается в следующем: предоставить код для аккуратной обработки ожидаемых или возможных ошибок.Для функции LastCol вам нужно LastCol = Rng.Column.
Выпуск 3
Минимальный синтаксис для оператора функции:
Function Name( ... parameters ...) As ReturnType
Два оператора функции должны заканчиваться: As Long.
Выпуск 4
Обратите внимание: "ActiveWorkbook.Worksheets (" RDBMergeSheet ")"
Если вы работаете с несколькими книгами, ActiveWorkbook недовольно.Если вы работаете только с одной книгой, ActiveWorkbook не требуется.Пожалуйста, не работайте с несколькими книгами, пока ваше понимание Excel VBA не улучшится.
Выпуск 5
Вы удаляете лист "RDBMergeSheet", а затем воссоздаете его, что ранит мою душу,Что еще более важно, вы потеряли заголовки столбцов.Я буду обсуждать этот вопрос далее в разделе Редизайн.
Заменить:
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"
на:
Set DestSh = Worksheets("RDBMergeSheet")
With DestSh
.Range(.Cells(2, 1), .Cells(Rows.Count, Columns.Count)).EntireRow.Delete
End With
Вы используете Rows.Count, With и Cells в своем коде, поэтому я не буду их объяснять.
.Range(.Cells(RowTop, ColLeft), .Cells(RowBottom, ColRight)) - это простой способ задания диапазона с верхними левыми и нижними правыми ячейками.
Я использовал .EntireRow, поэтому мне не нужны номера столбцов.Следующее дает тот же эффект:
.Rows("2:" & Rows.Count).EntireRow.Delete
Насколько я знаю ClearContents (что предпочитают некоторые люди) имеет тот же эффект, что и Delete.Это, конечно, занимает столько же микросекунд.При использовании выше, оба удаляют любые значения или форматирование со второй строки до последней строки листа.
Приведенное выше изменение означает, что строка 1 не изменяется и ширина столбцов не теряется.Мне не нужна AutoFit, которую вы использовали.
Issue 6
Пожалуйста, будьте систематичны в именовании ваших переменных.Вы используете StartRow в качестве первой строки и shLast в качестве последней строки исходного листа, а Last - в качестве последнего ряда конечного листа.Будет ли коллега, который берет на себя ведение вашего макроса, легко это понять?Помните ли вы его через шесть месяцев, когда этот макрос потребует некоторого обслуживания?
Разработайте систему именования, которая будет работать для вас.А еще лучше, соберитесь с коллегами и договоритесь о единой системе, чтобы все макросы вашего работодателя выглядели одинаково.Документируйте эту систему в интересах будущих сотрудников.Я бы назвал эти переменные: RowNumDestLast, RowNumSrcStart и RowNumSrcLast.То есть:,Эта система работает для меня, но ваша система может быть совершенно другой.Ключевой особенностью хорошей системы является то, что вы можете просмотреть свой код в течение года и сразу узнать, что делает каждый оператор.
Выпуск 7
If shLast > 0 And shLast >= StartRow Then
Вы устанавливаете StartRow на 1 и никогда не меняете его, так что если shLast >= StartRow, то shLast > 0.Достаточно следующего:
If shLast >= StartRow Then
Выпуск 8
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
Хорошо, что вы проверяете условия, которые приведут к фатальным ошибкам, но является ли это наиболее вероятной ошибкой? Даже если вы используете Excel 2003, у вас есть место для 65 535 человек и заголовок. Вы превысите ограничение на размер книги, прежде чем превысите максимальное количество строк.
Выпуск 9
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
Включает строку заголовка в диапазоне, который нужно скопировать. Поскольку позже я предложу совершенно другой метод, я не буду предлагать исправление.
Выпуск 10
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Почему вы вставляете значения и форматы отдельно?
Перестройка
С исправлениями выше, код вроде работает. С вашими исходными данными он устанавливает лист назначения на:
Age Name Dept
Name Age
Sathish 22
Sarathi 24
Age Name Dept
60 Saran Comp sce
31 Rajan B.com
Это не то, что вы ищете. Итак, остальная часть этого ответа касается дизайна: как вы добиваетесь внешнего вида, который ищете? Есть много подходов, но я предлагаю один и объясняю, почему я выбрал его, не обсуждая альтернативы.
Ключевые вопросы:
- Как определить, какие столбцы нужно объединить и в какой последовательности?
- Если в исходной таблице есть столбец, который вы не ожидаете, что вы будете делать? Кто-то собирает информацию, для которой нет центрального интереса, или имя столбца написано неправильно?
Я решил использовать существующие имена столбцов в рабочей таблице «RDBMergeSheet» для определения последовательности. Чтобы подготовить макрос для нового имени столбца, просто добавьте это имя в «RDBMergeSheet». Если я обнаружу имя столбца на исходном листе, которого нет в «RDBMergeSheet», я добавлю его справа. Это второе решение высветит ошибку, если имя столбца написано с ошибкой, но не принесет пользы, если кто-то собирает дополнительную информацию в исходной рабочей таблице.
Я не копирую форматы на лист "RDBMergeSheet", поскольку, если исходные листы отформатированы по-разному, каждая часть листа "RDBMergeSheet" будет отличаться.
Новые заявления и объяснения
Const RowFirstData As Long = 2
Const WShtDestName As String = "RDBMergeSheet"
Константа означает, что я использую имя в коде и могу изменить значение, изменив оператор Const.
Я предполагаю, что первая строка каждого листа содержит имена столбцов, а первая строка данных - 2. Я использую константу, чтобы прояснить это предположение. Можно было бы использовать это для написания кода, который обрабатывал бы другое количество строк заголовка, но я этого не сделал, потому что это усложнило бы код для небольшого преимущества.
ColNumDestLast = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, Columns.Count) определяет последний столбец строки 1, который, как я полагаю, является пустым. .End(xlToLeft) является VBA-эквивалентом клавиатуры Ctrl + Left. Если .Cells(1, Columns.Count) пусто, .Cells(1, Columns.Count).End(xlToLeft) возвращает первую ячейку слева, которая не является пустой. .Column дает номер столбца этой ячейки. То есть этот оператор устанавливает для ColNumDestStart номер столбца последней ячейки в строке 1 со значением.
ColHeadDest = .Range(.Cells(1, 1), .Cells(1, ColNumDestLast)).Value
Копирует значения из строки 1 в вариантный массив ColHeadDest. ColHeadDest будет переопределен этим оператором до (1 to 1, 1 to ColNumDestLast). Первое измерение предназначено для строк, из которых только один, а второе - для столбцов.
Запасной консолидированный
Я надеюсь, что я добавил достаточно комментариев для кода, чтобы иметь смысл. Вам все еще нужны исправленные LastRow и LastCol. Я мог бы заменить LastRow и LastCol, но я думаю, что предоставил достаточно нового кода, чтобы продолжить.
Option Explicit
Sub consolidate()
Dim ColHeadCrnt As String
Dim ColHeadDest() As Variant
Dim ColNumDestCrnt As Long
Dim ColNumDestLast As Long
Dim ColNumSrcCrnt As Long
Dim ColNumSrcLast As Long
Dim Found As Boolean
Dim RowNumDestCrnt As Long
Dim RowNumDestStart As Long
Dim RowNumSrcCrnt As Long
Dim RowNumSrcLast As Long
Dim WShtDest As Worksheet
Dim WShtSrc As Worksheet
Dim WShtSrcData() As Variant
Const RowNumFirstData As Long = 2
Const WShtDestName As String = "RDBMergeSheet"
'With Application
' .ScreenUpdating = False ' Don't use these
' .EnableEvents = False ' during development
'End With
Set WShtDest = Worksheets(WShtDestName)
With WShtDest
' Clear existing data and load column headings to ColHeadDest
.Rows("2:" & Rows.Count).EntireRow.Delete
ColNumDestLast = .Cells(1, Columns.Count).End(xlToLeft).Column
ColHeadDest = .Range(.Cells(1, 1), _
.Cells(1, ColNumDestLast)).Value
End With
' Used during development to check array loaded correctly
'For ColNumDestCrnt = 1 To ColNumDestLast
' Debug.Print ColHeadDest(1, ColNumDestCrnt)
'Next
RowNumDestStart = RowNumFirstData ' Start for first source worksheet
For Each WShtSrc In Worksheets
ColNumSrcLast = LastCol(WShtSrc)
RowNumSrcLast = LastRow(WShtSrc)
If WShtSrc.Name <> WShtDestName And _
RowNumSrcLast <> 0 Then
' Source sheet is not destination sheet and it is not empty.
With WShtSrc
' Load entire worksheet to array
WShtSrcData = .Range(.Cells(1, 1), _
.Cells(RowNumSrcLast, ColNumSrcLast)).Value
End With
With WShtDest
For ColNumSrcCrnt = 1 To ColNumSrcLast
' For each column in source worksheet
Found = False
ColHeadCrnt = WShtSrcData(1, ColNumSrcCrnt)
' Find matching column in destination worksheet
For ColNumDestCrnt = 1 To ColNumDestLast
If ColHeadCrnt = ColHeadDest(1, ColNumDestCrnt) Then
Found = True
Exit For
End If
Next ColNumDestCrnt
If Not Found Then
' Current source column's name is not present in the
' destination sheet Add new column name to array and
' destination worksheet
ColNumDestLast = ColNumDestLast + 1
ReDim Preserve ColHeadDest(1 To 1, 1 To ColNumDestLast)
ColNumDestCrnt = ColNumDestLast
With .Cells(1, ColNumDestCrnt)
.Value = ColHeadCrnt
.Font.Color = RGB(255, 0, 0)
End With
ColHeadDest(1, ColNumDestCrnt) = ColHeadCrnt
End If
' I could extract data from WShtSrcData to another array
' suitable for downloading to a column of a worksheet but
' it is easier to move the data directly to the worksheet.
' Also, athought downloading via an array is marginally
' faster than direct access, loading the array will reduce,
' and perhaps eliminate, the time benefit of using an array.
RowNumDestCrnt = RowNumDestStart
For RowNumSrcCrnt = RowNumFirstData To RowNumSrcLast
' Copy value from array of source data to destination sheet
.Cells(RowNumDestCrnt, ColNumDestCrnt) = _
WShtSrcData(RowNumSrcCrnt, ColNumSrcCrnt)
RowNumDestCrnt = RowNumDestCrnt + 1
Next
Next ColNumSrcCrnt
End With ' WShtDest
' Adjust RowNumDestStart ready for next source worksheet
RowNumDestStart = RowNumDestStart + RowNumSrcLast - RowNumFirstData + 1
End If ' Not destination sheet and not empty source sheet
Next WShtSrc
With WShtDest
' Leave workbook with destination worksheet visible
.Activate
End With
'With Application
' .ScreenUpdating = True
' .EnableEvents = True
'End With
End Sub