Jump to content



excel χωρις macro


Recommended Posts

Ήθελα μία βοήθεια σχετικά με κάτι που θέλω να κάνω σε excel. Αλλά θα θα ήθελα (εάν μπορεί να γίνει) χωρίς macro και κώδικα. Μόνο με κάποιο συνδυασμό, ίσως, συναρτήσεων.

Το πρόβλημα είναι:

Έχω δύο στήλες:Α και Β, στις οποίες βάζω εγώ με το χέρι τα παρακάτω δεδομένα:

Η "Α" περιέχει π.χ. 10 ονόματα που είναι οι εργαζόμενοι σε μία εταιρία.
Η "Β", δίπλα σε αυτούς που λείπουν μία ημέρα, έχει τον αριθμό "8" (οι οκτώ ώρες που λείπει στο 8-ωρο του)
Ας πούμε ότι μία ημέρα, λείπουν οι 1,2,10. Οπότε στο Β1, Β2 και Β10 θα υπάρχει το 8.

Τώρα, αυτό που θέλω είναι, με αυτά τα δεδομένα, σε ένα δεύτερο sheet στο ίδιο βιβλίο, να φτιάχνεται αυτόματα (εδώ είναι οι συναρτήσεις), μία στήλη, με τα ονόματα των απόντων στη σειρά.
Οπότε, για το συγκεκριμένο παράδειγμα, σε ένα δεύτερο sheet, να δημιουργείται αυτόματα μία στήλη:
Α1 - όνομα απόντως 1
Α2 - όνομα απόντως 2
Α3 - όνομα απόντως 10

Link to comment
Share on other sites

Σύμφωνα με όσα γνωρίζω μάλλον δεν γίνεται αυτό που ζητάς αυτόματα.


Χωρίς macro μπορείς να φτιάξεις την λίστα που θέλεις αλλά κάθε φορά που εισάγεις καινούρια στοιχεία για να ενημερωθεί θα πρέπει να το κάνεις χειροκίνητα. 

 

Για να δημιουργείται αυτόματα η στήλη/λίστα είναι απαραίτητη η χρήση μακροεντολών.

 

Και γιατί αποκλείεις την χρήση μακροεντολών ?

 

Link to comment
Share on other sites

On 22/4/2023 at 6:46 ΜΜ, το μέλος IOANNISTSA έγραψε:

Σύμφωνα με όσα γνωρίζω μάλλον δεν γίνεται αυτό που ζητάς αυτόματα.


Χωρίς macro μπορείς να φτιάξεις την λίστα που θέλεις αλλά κάθε φορά που εισάγεις καινούρια στοιχεία για να ενημερωθεί θα πρέπει να το κάνεις χειροκίνητα. 

 

Για να δημιουργείται αυτόματα η στήλη/λίστα είναι απαραίτητη η χρήση μακροεντολών.

 

Και γιατί αποκλείεις την χρήση μακροεντολών ?

 

Δεν την αποκλείω ακριβώς τη χρήση μακροεντολών. Απλά, θέλει αρκετές γνώσεις για να το φτιάξω με μακροεντολές, που τόσες γνώσεις δεν έχω. Με μακροεντολές γίνεται, αλλά είναι κάπως αρκετά υψηλό/περίπλοκο το στάδιο, που δεν έχω (για την ώρα, τουλάχιστον).

Link to comment
Share on other sites

Κάνε Copy-Paste τον κώδικα στο sheet1 οπως φαίνεται στην παρακάτω φωτογραφία

 

image.png.3efa98d9c548a4764b7c0a3f3fa83b77.png

 

 

 

image.png.fccc02b6cdb87784b4bb7efd3e512afe.png

 

image.png.1f05f6bdae6b922cb5f9a1677d7fe9bc.png

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     
 Board_Col = 1
 Board_Row = 1
 Target_Col = 1
 TargetSheetName = "Sheet2"
   
 x1 = 30
 x2 = 2

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.CutCopyMode = False

If Target.Column >= Board_Col - 1 And Target.Column < Board_Col + x2 Then

   If Target.Row >= Board_Row And Target.Row < Board_Row + x1 Then
      
      k = 0
       
      For i = 1 To x1
      
      dd = Cells(i + Board_Row - 1, 2 + Board_Col - 1)
       
         If dd = 8 Then
      
              k = k + 1
              Sheets(TargetSheetName).Cells(k, Target_Col) = Cells(i, x2 + Board_Col - 2)
          Else
              Sheets(TargetSheetName).Cells(i, Target_Col) = ""
         End If
       
      Next
       
     End If
 End If
   
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = True
    
End Sub

 

Έγινε επεξεργασία από IOANNISTSA
  • Like 2
Link to comment
Share on other sites

On 29/4/2023 at 12:40 ΜΜ, το μέλος serpico75 έγραψε:

Δεν την αποκλείω ακριβώς τη χρήση μακροεντολών. Απλά, θέλει αρκετές γνώσεις για να το φτιάξω με μακροεντολές, που τόσες γνώσεις δεν έχω. Με μακροεντολές γίνεται, αλλά είναι κάπως αρκετά υψηλό/περίπλοκο το στάδιο, που δεν έχω (για την ώρα, τουλάχιστον).

Τελικά σε βοήθησε καθόλου το MACRO (πέραν του like που έκανες) ?

 

Link to comment
Share on other sites

On 5/5/2023 at 9:19 ΜΜ, το μέλος IOANNISTSA έγραψε:

Τελικά σε βοήθησε καθόλου το MACRO (πέραν του like που έκανες) ?

 

Δεν τα καταφέρνω.

Έφτιαξα αρχικά το LAB_excel1.xlsx και σε αυτό έβαλα τις δύο στήλες με τους τίτλους, ακριβώς όπως τις δίνεις στη φωτογραφία (16 ονόματα).

Μετά έσωσα σε LAB_excel1.xlsm , σε αυτό έφτιαξα ένα sheet2.

Έφτιαξα μία macro, πήγα στο sheet1 και έκανα edit στον κώδικα στο sheet1. Εκεί copy-paste τον κώδικα που μου έδωσες.

Έτρεξα τη μακροεντολή, αλλά το sheet2 κενό.

 

Το παράξενο είναι πως, όποτε ανοίγω το excel (το αρχείο .xlsm), δε μου βγάζει επάνω την κίτρινη μπάρα που ρωτάει για ενεργοποίηση εκτέλεση macro.

Οπότε, μπορεί να είναι όλα σωστά, αλλά λόγω αυτού, να μην τρέχει η μακροεντολή με το run.

 

υγ στη φωτογραφία σου, εκεί δεξιά, εσύ έχεις "Worksheet - SelectionChange". Αυτό εγώ δεν μπορώ να το βρω πουθενά. Δεν ξέρω τί είναι.

Έγινε επεξεργασία από serpico75
Link to comment
Share on other sites

Κάνεις mouse click στο [DEVELOPER] και μετά στο [Visual basic] και εμφανίζεται το [Microsoft Visual Basic for Applications] Window

PRNT.SC

Captured with Lightshot

 

μετά  double click στο Sheet1

 

στο δεξί μέρος του παραθύρου κάνεις copy paste το Macro [Private Sub Worksheet_SelectionChange(ByVal Target As Range)]

 

 

PRNT.SC

Captured with Lightshot

 

επιλέγεις όλο το Macro οπως παρακάτω

 

PRNT.SC

Captured with Lightshot

 

 

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     
 Board_Col = 1
 Board_Row = 1
 Target_Col = 1
 TargetSheetName = "Sheet2"
   
 x1 = 30
 x2 = 2

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.CutCopyMode = False

If Target.Column >= Board_Col - 1 And Target.Column < Board_Col + x2 Then

   If Target.Row >= Board_Row And Target.Row < Board_Row + x1 Then
      
      k = 0
       
      For i = 1 To x1
      
      dd = Cells(i + Board_Row - 1, 2 + Board_Col - 1)
       
         If dd = 8 Then
      
              k = k + 1
              Sheets(TargetSheetName).Cells(k, Target_Col) = Cells(i, x2 + Board_Col - 2)
          Else
              Sheets(TargetSheetName).Cells(i, Target_Col) = ""
         End If
       
      Next
       
     End If
 End If
   
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = True
    
End Sub

 

 

Φτιάξε και ένα Macro [Events_on] σε ένα Module, όπως παρακάτω και κάνε [Run] μια φορά ή όταν τα Events δεν λειτουργούν
 

PRNT.SC

Captured with Lightshot

 

Sub Events_on()

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = True

End Sub

 

Link to comment
Share on other sites

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

Παρά τις οδηγίες σου, ακόμη καί με τα screenshoots, δεν τα καταφέρνω.

 

Πάντως, όταν φτιάχνω τα δικά μου αρχεία (.xlsx & .xlsm), το πιό σημαντικό, και αυτό που μου κάνει εντύπωση, που ίσως είναι και η λύση τού προβλήματος, είναι πως, όταν ανοίγω το .xlsm , δεν μου βγάζει επάνω την κίτρινη μπάρα που αναφέρεται στην ενεργοποίηση τού περιεχομένου. Που, νομίζω, αυτό έχει να κάνει με το εάν εκτελείται η μακροεντολή.

 

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

Link to comment
Share on other sites

image.thumb.png.36cec6a07d87dd0a09fbbffe7ce6f17d.png

On 12/5/2023 at 1:16 ΜΜ, το μέλος serpico75 έγραψε:

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

Παρά τις οδηγίες σου, ακόμη καί με τα screenshoots, δεν τα καταφέρνω.

To Macro "Private Sub Worksheet_SelectionChange" πρέπει να το κάνεις copy-paste στο Sheet1 και όχι σε ένα Module.
 

Double left mouse click στο Sheet1 και στο δεξί μέρος του παραθύρου κάνεις copy paste το Macro [Private Sub Worksheet_SelectionChange(ByVal Target As Range)]

 

image.thumb.png.9c7af0d011899a077503046537440917.png

  • Like 1
Link to comment
Share on other sites

Απίστευτο!! Σωστά το έκανα τόσον καιρό. Απλά, όταν άνοιγα την πρώτη φορά το αρχείο .xlsm, εγώ περίμενα να εκτελεστεί ο κώδικας, και να δω τα ονόματα που είχαν 8 απευθείας στο Sheet2. Το Sheet2, όμως, ήταν κενό, και έπρεπε να βάλω 8 ή βγάλω 8 σε ένα όνομα στο Sheet1 μία φορά, για να φέρει αποτελέσματα-ονόματα στο Sheet2. Ως εδώ καλά.

 

Το πρόβλημα είναι με τον κώδικα. Δεν είναι τόσο σωστός. Στο παράδειγμα που δίνεις, παίξε λίγο (βάλε βγάλε 8 ) ιδιαίτερα χαμηλά στα ονόματα 15 ή 16. Άλλες φορές στο Sheet2, μετά την εκτέλεση της macro, θα επαναλάβει π.χ. το Όνομα15 ένα κάνεις κάτι στο 15, ή μπορεί να έχεις 8 στο 14 και να μη στο έχει φέρει στη λίστα στο 14 στο Sheet2.  Ιδιαίτερα τα προβλήματα αυτά δημιουργούνται όταν σβήσεις ένα 8-άρι, και απλά πατήσεις Enter και όχι up/down cursor. Να σβήσεις δηλαδή και να πας σε πάνω/κάτω κελί. Δεν γίνεται να εκτελείται ο κώδικας με σβήσιμο και απλά Enter, και όχι με πάνω/κάτω βέλος;

Link to comment
Share on other sites

Δοκίμασε αυτό, καλύτερη προσέγγιση

 

https://www.udrop.com/8ayN/LAB_excel2.xlsm

 

Worksheet_Activate on Sheet2

 

 

Private Sub Worksheet_Activate()
 
 Board_Col = 1
 Board_Row = 1
 Target_Col = 1
 
 TargetSheetName = "Sheet2"
 SourceSheetName = "Sheet1"
   
 x1 = 30
 x2 = 2

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.CutCopyMode = False

Sheets(TargetSheetName).Range("A1:A30").ClearContents
    
k = 0
       
For i = 1 To x1
      
   dd = Sheets(SourceSheetName).Cells(i + Board_Row - 1, 2 + Board_Col - 1)
       
   If dd = 8 Then
      
        k = k + 1
        Sheets(TargetSheetName).Cells(k, Target_Col) = Sheets(SourceSheetName).Cells(i, x2 + Board_Col - 2)
   End If
        
Next
 
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = True

End Sub

 

 

image.png.8b6edc5a4110b260f728f37b7f43f0d6.png

  • Like 1
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Δημιουργία...

Important Information

Ο ιστότοπος theLab.gr χρησιμοποιεί cookies για να διασφαλίσει την καλύτερη εμπειρία σας κατά την περιήγηση. Μπορείτε να προσαρμόσετε τις ρυθμίσεις των cookies σας , διαφορετικά θα υποθέσουμε ότι είστε εντάξει για να συνεχίσετε.