Note: The other languages of the website are Google-translated. Back to English

Cum se îmbină rapid rândurile adiacente cu aceleași date în Excel?

Presupunând că aveți o foaie de lucru cu aceleași date în rândurile adiacente și acum doriți să îmbinați aceleași celule într-o singură celulă, astfel încât datele să arate îngrijite și frumoase. Cum combinați rândurile adiacente cu aceleași date rapid și convenabil? Astăzi, vă voi prezenta o modalitate rapidă de a rezolva această problemă.


Îmbinați rândurile adiacente ale acelorași date cu codul VBA

Desigur, puteți îmbina aceleași date cu Merge & Center , dar dacă există sute de celule care trebuie îmbinate, această metodă va consuma mult timp. Deci, următorul cod VBA vă poate ajuta să îmbinați cu ușurință aceleași date.

1. Țineți apăsat butonul ALT + F11 tastele și deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următoarea macro în fișierul Modulefereastră.

Sub MergeSameCell()
'Updateby Extendoffice
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

3. Apoi apăsați pe F5 tasta pentru a rula acest cod, un ecran este afișat pe ecran pentru selectarea unui interval cu care să lucrați. Vedeți captura de ecran:

doc fuzionează aceleași celule 2

4. Apoi faceți clic pe OK, aceleași date din coloana A vor fi combinate împreună. Vedeți captura de ecran:

doc fuzionează aceleași celule 1


Îmbinați rândurile adiacente ale acelorași date cu Kutools pentru Excel

Cu Îmbinați aceleași celule utilitatea Kutools pentru Excel, puteți îmbina rapid aceleași valori în mai multe coloane cu un singur clic.

Kutools pentru Excel : cu mai mult de 300 de programe de completare Excel la îndemână, gratuit pentru a încerca fără limitări în 30 de zile. 

După instalare Kutools pentru Excel, puteți face următoarele:

1. Selectați coloanele pe care doriți să le îmbinați rândurile adiacente cu aceleași date.

2. Clic Kutools > Merge & Split > Fuzionați aceleași celule, vezi captura de ecran:

3. Și apoi aceleași date din coloanele selectate au fost îmbinate într-o singură celulă. Vedeți captura de ecran:

doc fuzionează aceleași celule 4

Faceți clic pentru a descărca Kutools pentru Excel și încercare gratuită acum!

Pentru a afla mai multe despre acest lucru, vă rugăm să vizitați acest lucru Fuzionați aceleași celule caracteristică.


Demo: îmbinați aceleași celule într-o singură celulă sau anulați pentru a completa valorile duplicate:

Kutools pentru Excel: cu mai mult de 300 de programe de completare Excel la îndemână, încercați fără limitări în 30 de zile. Descărcați și proba gratuită acum!

Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (43)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum replic macrocomanda VBA pentru a îmbina celulele adiacente în coloane în loc de rânduri? Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Violeta, dublez rândul (mai jos). de exemplu, încercați, încercați, de exemplu, încercați și modificați codul la acesta: Next WorkRng.Parent.Range(Rng.Cells(1, i), Rng.Cells(1, j - 1)).Merge i = j - 1 It a îmbinat rândul de mai sus cu „ex.” și „încercați”
Acest comentariu a fost redus la minimum de moderatorul de pe site
pentru oricine încă încearcă să realizeze acest lucru, cred că l-am prins Începutul codului ************************************ ***** Sub MergeSameCell() 'Updateby20131127 Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "MergeSimilar" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address , Type:=8) Application.ScreenUpdating = False Application.DisplayAlerts = False 'xRows = WorkRng.Rows.Count xCols = WorkRng.Columns.Count 'Pentru fiecare Rng din WorkRng.Columns ' Pentru i = 1 To xRows - 1 ' Pentru j = i + 1 To xRows ' If Rng.Cells(i, 1).Value Rng.Cells(j, 1).Value Then ' Exit For ' End If ' Next ' WorkRng.Parent.Range(Rng.Cells(i , 1), Rng.Cells(j - 1, 1)).Merge ' i = j - 1 ' Următorul 'Next Pentru fiecare Rng din WorkRng.Rows For i = 1 To xCols - 1 For j = i + 1 To xCols If Rng.Cells(1, i).Value Rng.Cells(1, j).Value Then Exit For End If Next WorkRng.Parent.Range(Rng.Cells(1, i), Rng.Cells(1, j - 1)).Merge i = j - 1 Next Next Application.DisplayAlerts = True Appl ication.ScreenUpdating = True End Sub ************************************* Sfârșitul codului IE Pur și simplu modificați codul pentru a schimba orice referințe de rând cu referințe de coloană
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc mult!!! m-a ajutat într-un moment crucial
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest lucru mi-a fost util de atâtea ori :) Mulțumesc mult, mi-a economisit mult timp de muncă. Am o mică cerere. Încerc să găsesc o modalitate de a face aceeași îmbinare, dar când există celule goale sub fiecare valoare, să îmbină fiecare celulă cu toate celulele goale de mai jos. Cum pot modifica macro-ul? Vă mulțumesc anticipat
Acest comentariu a fost redus la minimum de moderatorul de pe site
Încercați acest cod Sub MergeSameCell() Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:= 8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count For Each Rng In WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1 ).Valoare Rng.Cells(j, 1).Valoare Apoi Ieșire pentru End If Next If Not IsEmpty(Rng.Cells(i, 1).Value) Sau Nu IsEmpty(Rng.Cells(j - 1, 1).Value ) Apoi WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge End If i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
încercați acest cod Sub MergeSameCell() Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:= 8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count For Each Rng In WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1 ).Valoare Rng.Cells(j, 1).Valoare Apoi Ieșire pentru End If Next If Not IsEmpty(Rng.Cells(i, 1).Value) Sau Nu IsEmpty(Rng.Cells(j - 1, 1).Value ) Apoi WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge End If i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dacă am același nume mint Raju 1000 Raju 2000 Monu 100 Monu 200 Atunci cum pot face numele Margii cu suma
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, când rulez această macrocomandă, primesc „Eroarea definită de aplicație sau definită de obiect” la linia WorkRng.Parent.Range(rng.Cells(i, 1), rng.Cells(j - 1, 1)).Merge Any idei cum să remediez asta? Cu stimă, Michal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Primesc aceeași eroare. ti-ai dat seama pana acum? daca ai facut, cum te-ai descurcat? Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Primesc aceeași eroare
Acest comentariu a fost redus la minimum de moderatorul de pe site
Las aici scriptul modificat, astfel încât să îmbine celulele de mai jos cu aceeași valoare sau cu celulă goală: Sub MergeSameCell() 'Updateby20131127 Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count For Each Rng In WorkRng.Columns For i = 1 La xRânduri - 1 Pentru j = i + 1 La xRânduri Dacă Rng.Cells(j, 1).Valoare „" Apoi Dacă Rng.Cells(i, 1).Valoare Rng.Cells(j, 1).Valoare Apoi Ieșire Pentru End If End If Next WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna va rog ajutati. Am o problemă cu codul, cu această linie. Ceva greșit? Dacă Rng.Cells(j, 1).Valoare „” Atunci
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună. Ar trebui să aveți: dacă Rng.Cells(j, 1).Value = "" atunci...
Acest comentariu a fost redus la minimum de moderatorul de pe site
Îmbinând frumos. Dar necesită specificarea intervalului în timpul rulării codului. Vreau să specific intervalul, adică B1: B50 în codul vba. Și alinierea din stânga sus, dar cum vă rog să ajutați.
Acest comentariu a fost redus la minimum de moderatorul de pe site
În timp ce rulați codul de mai sus, afișează o eroare de compilare: eroare de sintaxă. În linia în care a folosit „” și linia inferioară a acestui.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Și eu întâmpin această problemă cu această linie. Dacă Rng.Cells(j, 1).Valoare „” Atunci poate cineva să ajute?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, Cum pot pune intervalul automat fără intrarea utilizatorului
Acest comentariu a fost redus la minimum de moderatorul de pe site
Îmi pare rău, dar am pus pe altcineva să facă scriptul pentru mine, nu am cunoștințe care să vă ajut cu modificările.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna domnule, . Incerc codul vba dar nu merge. Mesaj de eroare pentru.408. În special, comentariul WorkRng.Parent. Interval(rng.Cells (i, 1), rng.Cells(j - 1, 1)).Merge. Vă rugăm să trimiteți soluția. Petrec mult timp să comas documentele. Am îmbinat în mare parte acest format de celule C20059290. Mulțumesc și salut Purusothaman. C
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă domnule, . Folosesc codul vba pentru foaia Excel pentru celulele de îmbinare. Nu funcționează a venit pentru eroarea 408. În special acest cod WorkRng.Parent. Interval(rng.Cells (i, 1), rng.Cells(j - 1, 1)).Merge. Dă soluția. Mulțumesc și salut Purusothaman
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Poate cineva să instruiască cu inginerie inversă - celule de demarging cu popularea aceeași valoare pentru toate.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Makro-ul funcționează, dar acum când vreau să filtrez pe coloana A se văd doar primele Informații din coloana B aplicabile coloanei A. Privind exemplul dat în makro, dacă vreau să filtrez luni după ce fuzionarea a fost făcută, doar Nicol va afișa și nu sunt afișate informații de la Lucy și Lily. Există vreo linie pe care să pot adăuga pentru a evita acest lucru?
Acest comentariu a fost redus la minimum de moderatorul de pe site
dacă chiar vrei să filtrezi, îmbinarea celulelor nu te va ajuta.
Acest comentariu a fost redus la minimum de moderatorul de pe site
In EXCEL INPUT NAME PRO1 PRO2 PRO3 A B C output A PRO1 A PRO2 A PRO3 B PRO1 B PRO2 B PRO3 C PRO1 C PRO2 C PRO3
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest lucru a fost foarte util și mi-a economisit timpul într-o mai mare măsură
Acest comentariu a fost redus la minimum de moderatorul de pe site
Codul VBA poate fi modificat pentru a obține același lucru pentru îmbinarea între coloane (spre deosebire de rândurile în jos, ca mai sus) și apoi repetat pentru toate rândurile?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Utilizați codul de mai sus și apoi transpuneți rezultatul
Acest comentariu a fost redus la minimum de moderatorul de pe site
Foarte util !! Mulțumesc mult
Acest comentariu a fost redus la minimum de moderatorul de pe site
O, amice, îmi salvezi multe zile. Mulțumesc!!!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
În linia de cod VBA de mai sus, numărul 19 "i=j-1"
cum ne va afecta oricum logica? Am eliminat-o și am reușit să obțin același rezultat!
Vreun scop specific de ce este prezent?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Este de a limita valoarea i la ultimul rând.
Vă rugăm să ignorați această postare!
Nu există comentarii postate aici încă
Încărcați mai
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL