Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] Αυτόματη ενημέρωση πίνακα (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1299-aytomati-enimerosi-pinaka.html)

skapet155 12-08-11 14:54

Αυτόματη ενημέρωση πίνακα
 
1 Συνημμένο(α)
Γεια σας παιδια , εχω και εγω ενα προβλημα
Σας επισυναπτω ενα αρχειο στο οποιο στο 1ο φυλλο εχω ημερομηνιες και σπιτια προς καθαρισμα , στο 2 φυλλο θελω να δημιουργειται ενας πινακα αντιστοιχος με αυτον που απεικονιζεται και να οποιο σπιτι χρειαζεται καθαρισμα να γραφει Κ
Δεν ξερω εαν μπορειται να βοηθησετε .
Σας ευχαριστω προκαταβολικα

Tasos 12-08-11 18:08

1 Συνημμένο(α)
Καλησπέρα σε όλους!
Σταύρο καλωσόρισες στο φόρουμ!
Μετακίνησα το μήνυμα σου σε νέο θέμα.
Η δημιουργία ενός τέτοιου πίνακα προϋποθέτει γνώσεις προχωρημένου χρήστη στην Excel.

Σου επισυνάπτω αρχικά ένα παράδειγμα από όπου:


  • Θα συμπληρώνεις τα κτίρια στη Λίστα Κτιρίων στο Φύλλο1 για μία και μοναδική φορά.
  • Στο φύλλο2 θα βλέπεις τα αποτελέσματα.
  • Αν προσθέσεις νέο κτίριο, αφού το συμπληρώσεις στη Λίστα Κτιρίων, θα πρέπει στο
    φύλλο2 να τραβήξεις την τελευταία στήλη προς τα δεξιά για να σου εμφανιστεί το νέο κτίριο με τις υπηρεσίες του.
Μελέτησε το και αν χρειαστείς κάτι γράψε στο φόρουμ.


Φιλικά


Τάσος



skapet155 13-08-11 07:56

Τασο , σε ευχαριστω πολυ ειναι οτι χρειαζομουνα αλλα δεν μπορουσα να το υλοποιησω.
Δεν ξερω εαν κανω καταχρηση αλλα οπως καταλαβαινεις κανω μια διαχειριση καθαριστριας .
Εαν καποιες μερες εχει 2 καθαρισματα δεν προλαβαινει στο ωραριο της τοτε θα μπορουσε το προγραμμα να την βαζει την επομενη μερα εαν ειναι ελευθερη και βεβαια εαν δεν εχει γινει check in

skapet155 13-08-11 08:06

1 Συνημμένο(α)
Συγνωμη κατα λαθος δεν συνεχισα το μηνυμα .
Στελνω το αρχειο απο το οποιο θα παιρνω τα στοιχεια check in , check out.
Απο αυτο αρχειο θα προκυπτει ο πινακας που εφτιαξες , με περιορισμους , καθε 2 φορες την εβδομαδα θα εχει αλλαγη "Α" , την ημερομηνια του check out θα πρεπει να γινεται καθαρισμα , και ολα αυτα με περιορισμους να μην πεφτουν 2 Καθαρισματα μαζι ( εαν ειναι δυνατον , εαν οχι να γινεται κοκκινο κ να προτεινεται 2 καθαριστριες ) 1 Καθαρισμα κ 1εως 2 Αλλαγες ειναι οκ , παραπανω παλι να αποφευγεται , εαν ειναι αδυνατον να γινεται κοκκινο κ να προτεινεται 2 καθαριστριες )
Ξερω ειναι πολυ δυσκολο με αρκετα if , και δεν ειμαι σιγουρος οτι ειναι υλοποιησιμο .
Ευχαριστω για αλλη μια φορα .

Tasos 14-08-11 11:18

Καλημέρα Σταύρο!
Το πρόβλημα για αρκετούς φίλους εδώ στο φόρουμ δεν είναι η δυσκολία της υλοποίησης αλλά
η σκέψη και ο χρόνος που θα χρειαστεί κανείς μέχρι να φτάσει στην υλοποίηση.

Στην ουσία ζητάς ολόκληρη εφαρμογή που θα χρειαστεί αρκετές ώρες για να τελειοποιηθεί.

Μια τέτοια λύση δεν μπορεί να δοθεί στα πλαίσια ενός θέματος του φόρουμ.

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

Φιλικά

Τάσος

skapet155 14-08-11 22:44

Ολα καλα Τασο σε ευχαριστω για την βοηθεια σου μεχρι τωρα

skapet155 16-08-11 13:33

καθως επεξεργαζομαι το αρχειο με τον συννημενο πινακα , διαπιστωσα οτι εαν εχω την ιδια ημερομηνια καθαρισμα σε μια κατοικια και επισης σε καποια αλλη , το Κ μπαινει στο κελι μονο για την 1 κατοικια και οχι για την δευτερη , πρεπει να αλλαξω κατι στους τυπους ?

Tasos 16-08-11 16:28

Καλησπέρα Σταύρο!

Ναι, θα χρειαστούν κάποιες μικροαλλαγές στους τύπους.
Στο αρχείο του παραδείγματος, στο Φύλλο1 και στη στήλη "D" ξεκινώντας από το κελί D2, συμπλήρωσε τον τύπο: =B2&C2.
Μπορείς αν θέλεις να κρύψεις αυτή τη στήλη.

Στο Φύλλο2 και στο κελί C2 συμπλήρωσε τον τύπο:
Κώδικας:

=IF(ISNA(MATCH($B2&C$1;Φύλλο1!$D:$D;0));"";IF(INDEX(Φύλλο1!$D:$D;MATCH($B2&C$1;Φύλλο1!$D:$D;0))=$B2&C$1;"K";""))
και σύρε τα κελιά δεξιά και κάτω όσο χρειαστεί.

Καλή συνέχεια!

Φιλικά

Τάσος

skapet155 17-08-11 08:55

ειναι πολυ καλο τασο , δουλευει μια χαρα , σε ευχαριστω.
πως θα μπορουσα οι φορμουλες που εχει ο πινακας στο Φυλλο2 να γινουν ισως με vba ωστε να μπορει καποιος να επεμβει και να μεταθεσει μερικα Κ σε αλλη ημερομηνια ?

Tasos 17-08-11 14:55

1 Συνημμένο(α)
Καλησπέρα Σταύρο!

Δες ένα παραδειγματικό κώδικα:
Κώδικας:

Option Explicit

Sub FillPlanTable()
    Dim rngSourceDates As Range
    Dim rngTargetDates As Range
    Dim rngRooms As Range
    Dim c As Range
    Dim d As Range
    Dim f As Range
    Dim FirstAddress As String
    Dim iCol As Integer
    Dim iRow As Integer

    Set rngSourceDates = Worksheets(1).Range("A:A")
    Set rngRooms = Range("C1:N1")
    On Error GoTo ErrH
    Set rngTargetDates = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = True
    With rngRooms
        .Offset(1).Resize(rngTargetDates.Count, .Count).Replace _
                What:=ChrW(922), Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False

        .Offset(1).Resize(rngTargetDates.Count, .Count).Replace _
                What:="K", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
    End With
    For Each c In rngTargetDates
        If Not IsEmpty(c) And IsDate(c) Then
            Set f = rngSourceDates.Find(c)
            If Not f Is Nothing Then
                FirstAddress = f.Address
                Do
                    Set d = rngRooms.Find(What:=f.Offset(, 1), LookIn:=xlValues)
                    If Not d Is Nothing Then
                        iRow = c.Row
                        iCol = d.Column
                        Cells(iRow, iCol) = "K"
                    End If
                    Set f = rngSourceDates.Find(What:=c, After:=f)
                    If f Is Nothing Then Exit Do
                Loop While f.Address <> FirstAddress
            End If
        End If
    Next
ErrH:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    If Err Then MsgBox Err & vbLf & Err.Description, vbExclamation
End Sub

Δες και το συνημμένο παράδειγμα παρακάτω.


Καλή συνέχεια!

Φιλικά

Τάσος


Η ώρα είναι 20:09.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2