Объединение ячеек без потери значения с использованием VBA в Microsoft Excel
В этой статье мы создадим макрос для объединения значений в двух последовательных ячейках.
Необработанные данные состоят из данных отдела, которые состоят из идентификатора отдела, номера строки и имени.
В этой статье мы хотим объединить идентификатор отдела и номер рулона в один столбец.
Объяснение кода
Сделать до IsEmpty (Cells (IntRow, IntCol))
Цикл Приведенный выше код используется для цикла до тех пор, пока не будет найдена пустая ячейка.
Ячейки (IntRow, IntCol) = Ячейки (IntRow, IntCol) & «-» & Ячейки (IntRow, IntCol + 1)
Приведенный выше код используется для объединения значений в одну ячейку, разделенную знаком «-».
Ячейки (IntRow, IntCol + 1) .ClearContents Приведенный выше код используется для удаления содержимого из ячейки.
Диапазон (Ячейки (IntRow, IntCol), Ячейки (IntRow, IntCol + 1)). Слияние Приведенный выше код используется для объединения двух последовательных ячеек вместе.
With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Приведенный выше код используется для выравнивания текста по центру по горизонтали и вертикали.
Пожалуйста, введите код ниже
Option Explicit Sub Connects() 'Declaring variables Dim IntRow, IntCol As Integer 'Initializing row and column number of first cell IntRow = 9 IntCol = 1 'Disabling screen updates Application.ScreenUpdating = False 'Looping through cells until blank cell is encountered in first column Do Until IsEmpty(Cells(IntRow, IntCol)) 'Merging value from two cells in the first column Cells(IntRow, IntCol) = Cells(IntRow, IntCol) & " - " & Cells(IntRow, IntCol + 1) 'Clearing content from second column Cells(IntRow, IntCol + 1).ClearContents 'Merging two cells Range(Cells(IntRow, IntCol), Cells(IntRow, IntCol + 1)).Merge 'Moving to next row IntRow = IntRow + 1 Loop 'Formatting the first column Columns(IntCol).Select 'Setting the horizonatal and vertical alignment to center With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Range("A10").Select End Sub
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]