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

Πώς να προσαρμόσετε αυτόματα το ύψος γραμμής των συγχωνευμένων κελιών στο Excel;

Στο Excel, μπορούμε να προσαρμόσουμε γρήγορα το ύψος της σειράς ώστε να ταιριάζει στα περιεχόμενα του κελιού χρησιμοποιώντας το Αυτόματη Προσαρμογή ύψους γραμμής χαρακτηριστικό, αλλά αυτή η λειτουργία αγνοεί εντελώς τα συγχωνευμένα κελιά. Δηλαδή, δεν μπορείτε να εφαρμόσετε το Αυτόματη Προσαρμογή ύψους γραμμής χαρακτηριστικό για να αλλάξετε το μέγεθος του ύψους των συγχωνευμένων κελιών, πρέπει να προσαρμόσετε χειροκίνητα το ύψος γραμμής για τα συγχωνευμένα κελιά ένα προς ένα. Σε αυτό το άρθρο, μπορώ να εισαγάγω μερικές γρήγορες μεθόδους για την επίλυση αυτού του προβλήματος.

Αυτόματη προσαρμογή ύψους γραμμής συγχωνευμένων κελιών με κωδικό VBA

Office Tab Ενεργοποιήστε την επεξεργασία με καρτέλες και την περιήγηση στο Office και κάντε την εργασία σας πολύ πιο εύκολη ...
Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%
  • Επαναχρησιμοποίηση οτιδήποτε: Προσθέστε τους πιο χρησιμοποιούμενους ή σύνθετους τύπους, γραφήματα και οτιδήποτε άλλο στα αγαπημένα σας και χρησιμοποιήστε τους γρήγορα στο μέλλον.
  • Περισσότερα από 20 χαρακτηριστικά κειμένου: Εξαγωγή αριθμού από συμβολοσειρά κειμένου. Εξαγωγή ή κατάργηση μέρους των κειμένων. Μετατροπή αριθμών και νομισμάτων σε αγγλικές λέξεις.
  • Συγχώνευση εργαλείων: Πολλαπλά βιβλία εργασίας και φύλλα σε ένα. Συγχώνευση πολλαπλών κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων. Συγχώνευση διπλών σειρών και αθροίσματος.
  • Διαχωριστικά εργαλεία: Διαχωρίστε δεδομένα σε πολλαπλά φύλλα με βάση την τιμή. Ένα βιβλίο εργασίας για πολλαπλά αρχεία Excel, PDF ή CSV. Μία στήλη σε πολλές στήλες.
  • Επικόλληση παράλειψης Κρυφές / φιλτραρισμένες σειρές; Καταμέτρηση και άθροισμα ανά χρώμα φόντου; Αποστολή εξατομικευμένων μηνυμάτων ηλεκτρονικού ταχυδρομείου σε πολλούς παραλήπτες μαζικά.
  • Σούπερ φίλτρο: Δημιουργήστε προηγμένα σχήματα φίλτρων και εφαρμόστε σε οποιοδήποτε φύλλο. Είδος ανά εβδομάδα, ημέρα, συχνότητα και άλλα. Φίλτρο με έντονη γραφή, φόρμουλες, σχόλια ...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Λειτουργεί με το Office 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας.

βέλος μπλε δεξιά φούσκα Αυτόματη προσαρμογή ύψους γραμμής συγχωνευμένων κελιών με κωδικό VBA


Ας υποθέσουμε ότι έχω ένα φύλλο εργασίας με μερικά συγχωνευμένα κελιά όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης και τώρα πρέπει να αλλάξω το μέγεθος του ύψους της γραμμής κελιού για να εμφανίσω ολόκληρο το περιεχόμενο, ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να προσαρμόσετε αυτόματα το ύψος σειράς πολλών συγχωνευμένων κελιών, παρακαλώ ως εξής:

doc-autofit-συγχωνευμένα-κελιά-1

1. Κρατήστε πατημένο το ALT + F11 και ανοίγει το Παράθυρο Microsoft Visual Basic for Applications.

2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο Παράθυρο ενότητας.

Κωδικός VBA: Αυτόματη προσαρμογή ύψους σειράς πολλαπλών συγχωνευμένων κελιών
Option Explicit
Public Sub AutoFitAll()
  Call AutoFitMergedCells(Range("a1:b2"))
   Call AutoFitMergedCells(Range("c4:d6"))
    Call AutoFitMergedCells(Range("e1:e3"))
End Sub
Public Sub AutoFitMergedCells(oRange As Range)
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldZZWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  With Sheets("Sheet4")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
  End With
End Sub

:

(1.) Στον παραπάνω κώδικα, μπορείτε να προσθέσετε νέα εύρη απλώς αντιγραφή Κλήση AutoFitMergedCells (εύρος ("a1: b2")) σενάριο πολλές φορές όπως θέλετε και αλλάξτε τις συγχωνευμένες περιοχές κυψελών στις ανάγκες σας.

(2.) Και θα πρέπει να αλλάξετε το τρέχον όνομα του φύλλου εργασίας Sheet4 στο όνομα του χρησιμοποιημένου φύλλου σας.

3. Στη συνέχεια πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα και τώρα, μπορείτε να δείτε ότι όλα τα συγχωνευμένα κελιά έχουν προσαρμοστεί αυτόματα στο περιεχόμενο των κυττάρων τους, δείτε το στιγμιότυπο οθόνης:

doc-autofit-συγχωνευμένα-κελιά-1


Σχετικό άρθρο:

Πώς να προσαρμόσετε αυτόματα το πλάτος της στήλης στο Excel;


Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου

<p >


Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
</ p >

Σχόλια (26)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτός ο κωδικός προκαλεί τη διαγραφή πρόσθετων σειρών. Έχω αριθμούς στην αριστερή πλευρά και οι στήλες δίπλα είναι συγχωνευμένα/αναδιπλωμένα δεδομένα. Για παράδειγμα, σε μια περιγραφή θέσης εργασίας, αναφέρετε τις ευθύνες με αριθμούς ακολουθούμενες από επεξήγηση καθήκοντος. Καμία ιδέα; Ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω εισάγει τα ακόλουθα, αλλά λαμβάνω ένα μήνυμα σφάλματος "Σφάλμα χρόνου εκτέλεσης '13': Ασυμφωνία πληκτρολογίου" Βοήθεια; Option Explicit Public Sub AutoFitAll() Call AutoFitMergedCells(Range("a8:h8")) Call AutoFitMergedCells(Range("a10:h10")) Call AutoFitMergedCells(Range("a11:h11")MerganFit"Call :h17")) Κλήση AutoFitMergedCells(Range("b17:h22")) Κλήση AutoFitMergedCells(Range("b22:h24")) Κλήση AutoFitMergedCells(Range("a24:h26")) Κλήση AutoellFitMergedCells ")) Τέλος Sub Public Sub AutoFitMergedCells(oRange As Range) Dim ύψος ως ακέραιος αριθμός Dim iPtr ως ακέραιος αριθμός Dim oldWidth ως Single Dim παλιόZZWidth ως Single Dim νέοΠλάτος Ως Single Dim νέοΎψος ως απλό με φύλλα ("Offer Letter") old ForWidth = = 26 Προς oRange.Columns.Count oldWidth = oldWidth + .Cells(28, oRange.Column + iPtr - 28).ColumnWidth Επόμενο iPtr oldWidth = .Cells(0, oRange.Column).ColumnWidth + .Cells.1, o Στήλη + 1).ColumnWidth oRange.MergeCells = False newWidth = Len(.Cells(oRange.Row, oRange.Column).Value) oldZZWidth = .Range("ZZ1").ColumnWidth .Range ="Left(Z1" .Κελιά(oRange.Row, oRange.Column).Τιμή, n ewWidth) .Range("ZZ1").WrapText = True .Columns("ZZ").ColumnWidth = oldWidth .Rows("1").EntireRow.AutoFit newHeight = .Rows("1").rowHeight / oRange.Rows .Count .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).rowHeight = newHeight oRange.MergeCells = True oRange.WrapText = True .Range("ZZ1 ").ClearContents .Range("ZZ1").ColumnWidth = oldZZWidth End With End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ για τον κωδικό! Τελικά λειτουργεί, αλλά... Το ύψος της σειράς μου γίνεται πολύ ύψος. Υπάρχει λύση για; Ευχαριστώ πολύ! Αυτός είναι ο κωδικός μου: Επιλογή Ρητό δημόσιο Sub AutoFitAll() Κλήση AutoFitMergedCells(Range("b162:i162")) Κλήση AutoFitMergedCells(Range("b166:i166")) Κλήση AutoFitMergedCells(Range("b168"s168:i170C) AutoFitMergedCells("b170"s172rgedan :i172")) Κλήση AutoFitMergedCells(Range("b0:i1")) End Sub Public Sub AutoFitMergedCells(oRange As Range) Dim tΎψος ως ακέραιος Dim iPtr Ως ακέραιος Dim oldWidth As Single Dim OldZMWidth SingleWidth As Single With Sheets("Rapport") oldWidth = 1 Για iPtr = 1 To Orange.Columns.Count oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth Επόμενο iPtr oldWidth = .Cells(1, oRan .Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth oRange.MergeCells = False newWidth = Len(.Cells(oRange.Row, oRange.Column).Τιμή) oldZZWidth ="ZZ"ange("ZZ"1. ).ColumnWidth .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth) .Range("ZZ1").WrapText = True .Columns("ZZ").ColumnWidth = oldWidth .Rows("1").EntireRow.AutoFit newHeight = . Γραμμές("1").Ύψος γραμμής / oRange.Rows.Count .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight oRange.MergeCells = True oRange.WrapText = True .Range("ZZXNUMX").ClearContents .Range("ZZXNUMX").ColumnWidth = oldZZWidth Τέλος με End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Danielle, αντιμετώπισα το ίδιο πρόβλημα όταν εκτελούσα τη μακροεντολή για δεύτερη φορά στην πρώτη σειρά. Ο κώδικας χρησιμοποιεί .Rows("1").EntireRow.AutoFit (γραμμή 26) και εάν εκτελείτε ενεργό, ας πούμε A1:B1, το κελί σας A1 έχει το WordWrapping που έχει οριστεί σε ON από τη γραμμή 30. Η πιο εύκολη λύση φαίνεται να είναι η εναλλαγή του WordWrapping off στην αρχή της υπο. Προσθέστε oRange.WrapText = True μεταξύ των γραμμών 13 και 14 και θα πρέπει να είστε εντάξει.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Επειδή το κελί "βοηθητικό" του ZZ1 χρησιμοποιεί την πρώτη σειρά (στήλη ZZ, σειρά 1), εάν υπάρχει ΟΠΟΙΟΔΗΠΟΤΕ στη σειρά 1 ψηλότερο από το κείμενο στη σειρά που θέλετε να προσαρμόσετε, το ύψος που προκύπτει θα είναι μεγαλύτερο από αυτό που θέλετε . Για να το διορθώσω αυτό, έκανα το βοηθητικό κελί την ίδια στήλη με την πρώτη στήλη στο oRange και έθεσα τον αριθμό της γραμμής στην τελευταία γραμμή στο Excel. Ελπίζω αυτό να σας βοηθήσει όπως και εμένα. 8) Ο Κωδικός μου: Επιλογή Ρητό Δημόσιο Sub AutoFitAll() Call AutoFitMergedCells(Range("A2:Z2")) End Sub Public Sub AutoFitMergedCells(oRange As Range) Dim tΎψος ως ακέραιος Dim iPtr ως ακέραιος Dim oldWidth ως Single Dim oldZZmWidth ως newHeight As Single With Sheets("Sheet1") oldWidth = 0 Για iPtr = 1 To Orange.Columns.Count oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth Επόμενο iPtr oldWidth = .Cells , oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth oRange.MergeCells = False newWidth = Len(.Cells(oRange.Row, oRange.Column).Τιμή) oldZWids 1", oRange.Column).ColumnWidth .Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Τιμή, νέοΠλάτος) .Cells("1048576"lumRan.1048576. .WrapText = True .Columns(oRange.Column).ColumnWidth = oldWidth .Rows("1048576").EntireRow.AutoFit newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count Σειρά) & ":" & CStr(oRange.Row + oRange.Rows.Co unt - 1)).RowHeight = νέοΎψος oRange.MergeCells = True oRange.WrapText = True .Cells("1048576", oRange.Column).ClearContents .Cells("1048576", oRange.ΤέλοςZWidth =Column). Υπο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ για τον κωδικό! Έχω το ίδιο πρόβλημα με αυτόν τον κωδικό όπως DANIËLLE_01.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για τον κωδικό, λίγο πολύ αυτό που χρειαζόμουν. Ωστόσο, δύο παρατηρήσεις: 1) όταν εκτελώ τη μακροεντολή στην ίδια σειρά με το "βοηθητικό" κελί (ZZ1), η αυτόματη προσαρμογή (γραμμή 26) θα μπερδευτεί, επειδή ολόκληρη η συμβολοσειρά είναι προσαρμοσμένη σε ένα στενό κελί. Συνιστώ να προσθέσετε oRange.WrapText = False στην αρχή (ή να μετακινήσετε το βοηθητικό κελί κάπου μακριά, αν είναι δυνατόν). 2) ποιος είναι ο σκοπός της γραμμής 19; Υπολογίζετε το oldWidth στις γραμμές 16-18, αλλά στη συνέχεια παρακάμπτετε τον υπολογισμό στη γραμμή 19, χρησιμοποιώντας μόνο δύο στήλες. Όταν δοκίμασα το δευτερεύον σε συγχωνευμένα κελιά πλάτους τριών στηλών, λειτούργησε καλύτερα όταν αγνόησα τη γραμμή... Ευχαριστώ και πάλι
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ για τον κωδικό. Υπάρχει κάποιος τρόπος να εκτελέσετε τη μακροεντολή μόλις πληκτρολογήσετε κείμενο σε ένα πεδίο και πατήσετε enter;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Εξαιρετικό αλλά ακριβώς το ίδιο πρόβλημα με την Danielle, οι σειρές είναι πολύ ψηλές τώρα. Παρακαλώ κάποιος να βοηθήσει!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λειτουργεί τέλεια, αλλά οι σειρές είναι πολύ ψηλές! Μπορούμε να το διορθώσουμε αυτό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για τη δημοσίευση αυτού, είμαι αξιοπρεπής με το excel και συνήθως μπορώ να καταλάβω τις προσαρμογές μου, αλλά δεν φαίνεται να μπορώ να βρω λύση για ένα πρόβλημα που αντιμετωπίζω ή αν υπάρχει. Έχω τεράστιο όγκο δεδομένων στα κελιά (που υπερβαίνει το όριο ύψους ενός κελιού των 409.5). Το πρόβλημα είναι ότι αυτό το VBA τρέχει με τον ίδιο περιορισμό. Έτσι, ορισμένα από τα δεδομένα μου αποκόπτονται, παρόλο που οι σειρές συγχωνεύονται και το συνδυασμένο όριο ύψους κελιού είναι 819, αφού το VBA προσαρμόζει το ύψος κελιού με βάση το μεμονωμένο κελί ZZ1. Υπάρχει ούτως ή άλλως να προσαρμόσω τον κωδικό ώστε να επιτρέπει στο προσαρμοσμένο ύψος κελιού να περιλαμβάνει το διαθέσιμο ύψος στις συγχωνευμένες σειρές ή ζητώ το αδύνατο; Ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για τον κωδικό. Ωστόσο, το ύψος των σειρών μου προσαρμόζεται, αλλά τώρα αρκετά. Πώς μπορώ να το διορθώσω;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Επειδή το κελί "βοηθητικό" του ZZ1 χρησιμοποιεί την πρώτη σειρά (στήλη ZZ, σειρά 1), εάν υπάρχει ΟΠΟΙΟΔΗΠΟΤΕ στη σειρά 1 ψηλότερο από το κείμενο στη σειρά που θέλετε να προσαρμόσετε, το ύψος που προκύπτει θα είναι μεγαλύτερο από αυτό που θέλετε . Για να το διορθώσω αυτό, έκανα το βοηθητικό κελί την ίδια στήλη με την πρώτη στήλη στο oRange και έθεσα τον αριθμό της γραμμής στην τελευταία γραμμή στο Excel. Ελπίζω αυτό να σας βοηθήσει όπως και εμένα. 8) Ο Κωδικός μου: Επιλογή Ρητό Δημόσιο Sub AutoFitAll() Call AutoFitMergedCells(Range("A2:Z2")) End Sub Public Sub AutoFitMergedCells(oRange As Range) Dim tΎψος ως ακέραιος Dim iPtr ως ακέραιος Dim oldWidth ως Single Dim oldZZmWidth ως newHeight As Single With Sheets("Sheet1") oldWidth = 0 Για iPtr = 1 To Orange.Columns.Count oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth Επόμενο iPtr oldWidth = .Cells , oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth oRange.MergeCells = False newWidth = Len(.Cells(oRange.Row, oRange.Column).Τιμή) oldZWids 1", oRange.Column).ColumnWidth .Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Τιμή, νέοΠλάτος) .Cells("1048576"lumRan.1048576. .WrapText = True .Columns(oRange.Column).ColumnWidth = oldWidth .Rows("1048576").EntireRow.AutoFit newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count Σειρά) & ":" & CStr(oRange.Row + oRange.Rows.Co unt - 1)).RowHeight = νέοΎψος oRange.MergeCells = True oRange.WrapText = True .Cells("1048576", oRange.Column).ClearContents .Cells("1048576", oRange.ΤέλοςZWidth =Column). Υπο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ο κώδικάς μου δεν θα εκτελεστεί καν. Απλώς λαμβάνω ένα σφάλμα μεταγλώττισης όταν προσπαθώ να καλέσω το AutoFitMergedCells - Αναμενόμενη συνάρτηση ή μεταβλητή;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Προσπαθώ να καταλάβω την αναγκαιότητα της γραμμής 19. Εκχωρείτε ξανά μια τιμή στο OldWidth. Μπορείτε παρακαλώ να εξηγήσετε;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δημιούργησα πρόσθετο για Αυτόματη προσαρμογή σε ύψος σειράς πολλών συγχωνευμένων κελιών.
Χρησιμοποιήστε αυτό, εάν θέλετε να προσαρμόσετε αυτόματα το ύψος της σειράς.
[Έκδοση 2.6 · toowaki/AutoFitRowEx · GitHub]
https://github.com/toowaki/AutoFitRowEx/releases/tag/2.6.2
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό είναι πολύ χρήσιμο, ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πιστεύω ότι ο λόγος που τα ύψη σειρών δεν υπολογίζονται σωστά σχετίζεται με αυτές τις γραμμές κώδικα
Για iPtr = 1 Προς oRange.Columns.Count
oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
Επόμενο iPtr
oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth

Η μεταβλητή OldWidth ορίζεται στο άθροισμα των πλάτη των στηλών στην περιοχή, αλλά για κάποιο λόγο επαναφέρεται μόνο στο πλάτος των δύο πρώτων στηλών. Επομένως, οι 3 πρώτες γραμμές κώδικα καθίστανται περιττές από την 4η γραμμή. Όταν αφαίρεσα τη γραμμή ήταν πολύ καλύτερα, αλλά το άλλο ζήτημα που βρήκα ήταν ότι πρέπει να βεβαιωθείτε ότι η γραμματοσειρά και το μέγεθος γραμματοσειράς του προσωρινού κελιού (ZZ1 στον κώδικα του παραδείγματος) πρέπει να ταιριάζουν με τη γραμματοσειρά και το μέγεθος των συγχωνευμένων κελιών ; Διαφορετικά, το κείμενο δεν θα αναδιπλώνεται με τον ίδιο τρόπο όπως τα συγχωνευμένα κελιά και ενδέχεται να μην έχει το σωστό ύψος.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
δεν λειτουργεί, ο κωδικός πρόσβασης που έχετε ορίσει στον κωδικό σας δεν λειτουργεί στον κώδικά σας
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό δεν λειτουργεί για μένα}
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ, αυτό με βοήθησε με ένα σεντόνι με το οποίο δεν είμαι ευχαριστημένος εδώ και χρόνια.

Άλλαξα λίγο τα πράγματα, τα συγχωνευμένα κελιά μου είναι όλα σε μια στήλη, οπότε το υπολόγισα έξω από τον βρόχο και το πέρασα. Τοποθέτησα επίσης ένα Φύλλο1 που είναι κρυφό και χειροποίησα τις στήλες/γραμμές εκεί ώστε να μην επηρεάσω το φύλλο στο οποίο εργάζομαι. Οι παραπομπές θα πρέπει πιθανώς να είναι πιο σαφείς:

Public Sub AutoFitMergedCells (oRange As Range, ByVal dblWidth as Double)



Μειώνει το dblΎψος ως διπλό



Με το orRange.Parent

oRange.MergeCells = False

Sheet1.Range("A1") = oRange.Cells(1, 1).Τιμή

Sheet1.Range("A1").WrapText = True

Sheet1.Columns(1).ColumnWidth = dblWidth

Sheet1.Rows(1).EntireRow.AutoFit

dblHeight = Sheet1.Rows(1).RowHeight / orRange.Rows.Count

oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight = newHeight

oRange.MergeCells = True

oRange.WrapText = Αληθινό

Sheet1.Range("A1").ClearContents

Τέλος με



Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γαμώτο, με δάγκωσε αντιγραφή/επικόλληση. Επίσης, με σαφείς αναφορές φύλλων, το With δεν χρειάζεται:

Public Sub AutoFitMergedCells (oRange As Range, ByVal dblWidth as Double)



oRange.MergeCells = False

Sheet1.Range("A1") = oRange.Cells(1, 1).Τιμή

Sheet1.Range("A1").WrapText = True

Sheet1.Columns(1).ColumnWidth = dblWidth

Sheet1.Rows(1).EntireRow.AutoFit

oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight _

= Φύλλο1.Σειρές(1).Ύψος γραμμής / ήΕύρος.Σειρά.Αριθμός

oRange.MergeCells = True

oRange.WrapText = Αληθινό



Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπάρχει ένα όριο στο μέγεθος - εάν το συνολικό ύψος που απαιτείται είναι μεγαλύτερο από 409.5, θα κάνει μόνο αυτό που ταιριάζει στο 409.5 και θα το απλώσει στο ύψος των συγχωνευμένων κελιών και δεν θα δείτε το υπόλοιπο. Ήλπιζα ότι αυτό θα έλυνε μήκη κειμένου μεγαλύτερα από το μέγιστο ύψος γραμμής (409.5). Νομίζω ότι ίσως χρειαστεί να επαναλάβετε και να διαιρέσετε το κείμενο σε αυτό που μπορεί να χωρέσει στο πρώτο μέγιστο ύψος των 409.5 και, στη συνέχεια, βάλτε το υπόλοιπο σε ένα άλλο κελί (ZZ2) και ούτω καθεξής μέχρι να χωρέσει, μετά μετρήστε τις σειρές σε κάθε κελί και στη συνέχεια λάβετε το συνολικό απαιτούμενο ύψος.
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες