Unisci celle senza perdere i valori che utilizzano VBA in Microsoft Excel
In questo articolo, creeremo una macro per unire i valori in due celle consecutive.
I dati grezzi sono costituiti da dati dipartimentali, che consistono in ID reparto, numero riga e nome.
In questo articolo, vogliamo unire l’ID reparto e il numero di roll in una singola colonna.
Spiegazione del codice
Do Until IsEmpty (Cells (IntRow, IntCol))
Loop Il codice precedente viene utilizzato per eseguire il loop finché non viene trovata una cella vuota.
Celle (IntRow, IntCol) = Celle (IntRow, IntCol) e “-” e Celle (IntRow, IntCol + 1)
Il codice sopra viene utilizzato per concatinare i valori in una singola cella, separati da “-“.
Cells (IntRow, IntCol + 1) .ClearContents Il codice precedente viene utilizzato per eliminare il contenuto dalla cella.
Intervallo (Celle (IntRow, IntCol), Celle (IntRow, IntCol + 1)) Unisci Il codice sopra viene utilizzato per unire due celle consecutive insieme.
Con selezione .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Il codice precedente viene utilizzato per allineare il testo al centro orizzontalmente e verticalmente.
Segui sotto per il codice
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
Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook e Facebook.
Ci piacerebbe sentire la tua opinione, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici a [email protected]