[Excel07] πίνακες με συγχρονισμένη αλλαγή μεγέθους

[νικολας2000]

Καλησπέρα..!!!!
Ίσως το πρόβλημα που έχω να είναι πολύ απλό,ίσως και πολύ σύνθετο ,απλά κόλλησα,,,!!!
Έχω δύο πίνακες ο ένας ενημερώνεται από τον χρήστη και ο δεύτερος λαμβάνει δεδομένα από τον πρώτο.
Έχω και στους δύο γραμμή συνόλου (αν αυτό παίζει κάποιο ρόλο).
Θα ήθελα εφόσον αλλάζω το μέγεθος γραμμών του πρώτου να αλλάξει ανάλογα και ο δεύτερος.
Ευχαριστώ εκ των προτέρων....!!!!

[Spirosgr]

Καλημέρα
Νικόλα, καλώς όρισες στο ms-office.gr

Το πρόβλημά σου, κατ αρχάς λύνεται με κώδικα.
Είναι πολύ απλό ως προς την δημιουργία και εκτέλεση, αλλά μπορεί να γίνει
πολύ σύνθετο ανάλογα με κάποιες παραμέτρους που θα εμπλακούν.

Έστω πίνακας 1 αυτός του χρήστη και πίνακας 2 ο...αυτόματος.

Τι πίνακες είναι;
Που βρίσκονται;
Ο πίνακας 1, παίρνει δεδομένα και από κάπου αλλού ή μόνο ο χρήστης τον τροποποιεί;
Πως συνδέεται ο πίνακας 2 με τον πίνακα 1;
Έχει τύπους ο πίνακας 2;
Οι αλλαγές στον πίνακα 1 θα είναι και στα δεδομένα τα υπάρχοντα;
Μόνο θα προστίθενται γραμμές στον πίνακα 1, ή θα διαγράφονται και κάποιες;
Οι στήλες στον πίνακα 1 παραμένουν ίδιες, ή μπορεί να αυξηθούν;
Αν αυξηθούν θα πρέπει να αυξηθούν και στον πίνακα 2;

Ένα σωρό ερωτήματα...

Ανέβασε λοιπόν ένα παραδειγματικό αρχείο,
πες μας με κάθε λεπτομέρεια τι θα κάνεις και αν είναι όπως το φαντάζομαι
βλέπουμε τη λύση...

[νικολας2000]

αποθηκη τεστ 10.xlsx
Σίγουρα έγραψα βεβιασμένα..!!
Ανέβασα το αρχείο που δουλεύω και λίγα λόγια γι αυτό.
Πίνακας 1 : αγορές
Πίνακας 2 : πωλήσεις
Πίνακας 3 : αποθήκη
Ενημερώνω τις αγορές με έναν μοναδικό κωδικό και τις πωλήσεις βάση του ίδιου κωδικού. Με δύο συναρτήσεις στην αποθήκη και βάση του μοναδικού κωδικού έχω ενημέρωση της αποθήκης.
Όμως θα πρέπει να ελέγχω το μέγεθος του πίνακα της αποθήκης κάθε φορά που αλλάζει ο πίνακας αγορών.
Αν υπάρχει κάποια λύση ευπρόσδεκτη.
Ευχαριστώ...!!!!!

[Spirosgr]

Λοιπόν Νικόλα, πάμε μεθοδικά να το κάνουμε σωστά.

Κατ' αρχάς θα πρέπει να κάνεις το βιβλίο .xlsm, για να δέχεται κώδικα.

Ο Πίνακας στο αγορα, έχει όνομα Πίνακας4, αλλά αυτό μπορεί να μην είναι το πραγματικό όνομα στο καλό βιβλίο σου.
Ο Πίνακας στο αποθήκη, έχει όνομα Πίνακας3, αλλά ούτε αυτό μπορεί να μην είναι το πραγματικό όνομα στο καλό βιβλίο σου.
Προς το παρών θα τους λέμε με αυτά τα ονόματα...

Πάμε στο αγορά και στον Πίνακα4, και ονομάζουμε την στήλη Κ (τεμάχια) = ColTarget

Πάμε στον κώδικα (Alt + F11) και στο φύλλο, αγορά αντιγράφουμε αυτό:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub

    Dim rng         As Range
    Set rng = Me.Range("ColTarget")

    If Intersect(Target, rng) Is Nothing Then Exit Sub

    ResizeTbl
End Sub

Βάζουμε μια module, και σε αυτήν αντιγράφουμε αυτό:

Sub ResizeTbl()
    Dim tbl1        As ListObject
    Dim tbl2        As ListObject
    'Όνομα πρώτου πίνακα στο αγορα
    Set tbl1 = Sheet1.ListObjects("Πίνακας4")
    'Όνομα δεύτερου πίνακα στο αποθηκη
    Set tbl2 = Sheet3.ListObjects("Πίνακας3")

    Dim strCol      As String
    Dim endCol      As String
    Dim c           As Long
    strCol = Split(tbl2.ListColumns(1).Range.Address, "$")(1)
    c = tbl2.DataBodyRange.Columns.Count
    endCol = Split(tbl2.ListColumns(c).Range.Address, "$")(1)

    Dim lRows       As Long
    lRows = tbl1.DataBodyRange.Rows.Count

    Dim HeadRow     As Long
    HeadRow = tbl2.HeaderRowRange.Row

    Dim tRow        As Byte
    Dim rRows       As Long
    On Error Resume Next
    tRow = tbl2.TotalsRowRange.Rows.Count
    On Error GoTo 0

    rRows = lRows + HeadRow + tRow

    tbl2.Resize Range(strCol & HeadRow & ":" & endCol & rRows)
End Sub

Τώρα
Στις θέσεις των ονομάτων πινάκων (κόκκινα)
βάζουμε τα πραγματικά ονόματα του «καλού» βιβλίου.
Στις θέσεις των ονομάτων φύλλων (μπλε)
βάζουμε τα πραγματικά κωδικά ονόματα των φύλλων του «καλού» βιβλίου.

Εκτέλεση
Βάζουμε στον Πίνακα 4, μια νέα γραμμή στο τέλος.
Πληκτρολογούμε ό,τι θέλουμε και
όταν πληκτρολογήσουμε στην στήλη Κ (ονομασμένη) , κάποια τεμάχια, τότε ο Πίνακας 3,
θα πάρει αυτόματα μια νέα γραμμή στο τέλος του.

Σημειώσεις
Προσθήκη νέας γραμμής στον 4, πάντα στο τέλος, πριν τα σύνολα
Προσθήκη αυτόματης γραμμής στον 3,
με την ολοκλήρωση πληκτρολόγησης στην στήλη Κ = ColTarget (Enter)
Το πόσες στήλες έχουν οι πίνακες, αδιάφορο (το χειρίζεται ο κώδικας)
Το αν έχουν γραμμή συνόλων, αδιάφορο (το χειρίζεται ο κώδικας)
Το αν υπάρχουν κι άλλοι πίνακες στα ίδια φύλλα, αδιάφορο

Στην εικόνα, βλέπεις που θα βρεις τα κωδικά ονόματα φύλλων.
Είναι αυτά που είναι έξω από την παρένθεση

Δοκίμασε και τα λέμε...

[νικολας2000]

Ευχαριστώ για την βοήθεια, θα κάνω την εφαρμογή και θα ενημερώσω για το αποτέλεσμα.

[νικολας2000]

Αρχική Δημοσίευση από Spirosgr

Λοιπόν Νικόλα, πάμε μεθοδικά να το κάνουμε σωστά.

Κατ' αρχάς θα πρέπει να κάνεις το βιβλίο .xlsm, για να δέχεται κώδικα.

Ο Πίνακας στο αγορα, έχει όνομα Πίνακας4, αλλά αυτό μπορεί να μην είναι το πραγματικό όνομα στο καλό βιβλίο σου.
Ο Πίνακας στο αποθήκη, έχει όνομα Πίνακας3, αλλά ούτε αυτό μπορεί να μην είναι το πραγματικό όνομα στο καλό βιβλίο σου.
Προς το παρών θα τους λέμε με αυτά τα ονόματα...

Πάμε στο αγορά και στον Πίνακα4, και ονομάζουμε την στήλη Κ (τεμάχια) = ColTarget

Πάμε στον κώδικα (Alt + F11) και στο φύλλο, αγορά αντιγράφουμε αυτό:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub

    Dim rng         As Range
    Set rng = Me.Range("ColTarget")

    If Intersect(Target, rng) Is Nothing Then Exit Sub

    ResizeTbl
End Sub

Βάζουμε μια module, και σε αυτήν αντιγράφουμε αυτό:

Sub ResizeTbl()
    Dim tbl1        As ListObject
    Dim tbl2        As ListObject
    'Όνομα πρώτου πίνακα στο αγορα
    Set tbl1 = Sheet1.ListObjects("Πίνακας4")
    'Όνομα δεύτερου πίνακα στο αποθηκη
    Set tbl2 = Sheet3.ListObjects("Πίνακας3")

    Dim strCol      As String
    Dim endCol      As String
    Dim c           As Long
    strCol = Split(tbl2.ListColumns(1).Range.Address, "$")(1)
    c = tbl2.DataBodyRange.Columns.Count
    endCol = Split(tbl2.ListColumns(c).Range.Address, "$")(1)

    Dim lRows       As Long
    lRows = tbl1.DataBodyRange.Rows.Count

    Dim HeadRow     As Long
    HeadRow = tbl2.HeaderRowRange.Row

    Dim tRow        As Byte
    Dim rRows       As Long
    On Error Resume Next
    tRow = tbl2.TotalsRowRange.Rows.Count
    On Error GoTo 0

    rRows = lRows + HeadRow + tRow

    tbl2.Resize Range(strCol & HeadRow & ":" & endCol & rRows)
End Sub

Τώρα
Στις θέσεις των ονομάτων πινάκων (κόκκινα)
βάζουμε τα πραγματικά ονόματα του «καλού» βιβλίου.
Στις θέσεις των ονομάτων φύλλων (μπλε)
βάζουμε τα πραγματικά κωδικά ονόματα των φύλλων του «καλού» βιβλίου.

Εκτέλεση
Βάζουμε στον Πίνακα 4, μια νέα γραμμή στο τέλος.
Πληκτρολογούμε ό,τι θέλουμε και
όταν πληκτρολογήσουμε στην στήλη Κ (ονομασμένη) , κάποια τεμάχια, τότε ο Πίνακας 3,
θα πάρει αυτόματα μια νέα γραμμή στο τέλος του.

Σημειώσεις
Προσθήκη νέας γραμμής στον 4, πάντα στο τέλος, πριν τα σύνολα
Προσθήκη αυτόματης γραμμής στον 3,
με την ολοκλήρωση πληκτρολόγησης στην στήλη Κ = ColTarget (Enter)
Το πόσες στήλες έχουν οι πίνακες, αδιάφορο (το χειρίζεται ο κώδικας)
Το αν έχουν γραμμή συνόλων, αδιάφορο (το χειρίζεται ο κώδικας)
Το αν υπάρχουν κι άλλοι πίνακες στα ίδια φύλλα, αδιάφορο

Στην εικόνα, βλέπεις που θα βρεις τα κωδικά ονόματα φύλλων.
Είναι αυτά που είναι έξω από την παρένθεση

Δοκίμασε και τα λέμε...

Δουλεύει άψογα..!!
Έχω την εντύπωση πως με κώδικα πολλαπλασιάζονται οι δυνατότητες στο excel.
Ευχαριστώ γισ την βοήθεια....!!!!!!

[Spirosgr]

Καλή συνέχεια, Νικόλα.