IOANNISTSA

Δοκίμασε αυτό, καλύτερη προσέγγιση 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

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)]

Για παν ενδεχόμενων Download my test excel sheet. https://www.udrop.com/file/880N/LAB_excel1.xlsm

Κάνεις mouse click στο [DEVELOPER] και μετά στο [Visual basic] και εμφανίζεται το [Microsoft Visual Basic for Applications] Window Screenshot PRNT.SC Captured with Lightshot μετά double click στο Sheet1 στο δεξί μέρος του παραθύρου κάνεις copy paste το Macro [Private Sub Worksheet_SelectionChange(ByVal Target As Range)] Screenshot PRNT.SC Captured with Lightshot επιλέγεις όλο το Macro οπως παρακάτω Screenshot 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 δεν λειτουργούν Screenshot PRNT.SC Captured with Lightshot Sub Events_on() Application.EnableEvents = True Application.ScreenUpdating = True Application.CutCopyMode = True End Sub

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

Κάνε Copy-Paste τον κώδικα στο sheet1 οπως φαίνεται στην παρακάτω φωτογραφία 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 μπορείς να φτιάξεις την λίστα που θέλεις αλλά κάθε φορά που εισάγεις καινούρια στοιχεία για να ενημερωθεί θα πρέπει να το κάνεις χειροκίνητα. Για να δημιουργείται αυτόματα η στήλη/λίστα είναι απαραίτητη η χρήση μακροεντολών. Και γιατί αποκλείεις την χρήση μακροεντολών ?

Κολλήσαμε οικογενειακός (για πρώτη φορά) λίγο πριν τα Χριστούγεννα, εγώ (57) η γυναίκα μου(57) και η πεθερά(90) μου. Χωρίς να λάβουμε υπόψιν ηλικίες, προβλήματα υγείας, φυσική κατάσταση κλπ τα συμπτώματα που είχαμε ήταν μη άξια λόγου και κράτησαν μια μέρα και χωρίς πυρετό (μέγιστη 37,4). Το τελευταίο εμβόλιο το είχαμε κάνει στις 7 Ιανουαρίου του 22. Με βάση την εξέλιξη του ιού έως τώρα άλλη δόση δεν βλέπω να κάνουμε εκτός και κάτι αλλάξει δραματικά προς το χειρότερο.

Υπάρχει και το Bosch GBH 2-28 F Professional 880W στα 220 ευρώ

Το Computer αγοράτηκε το 2011 και παραμενει χωρίς Format από τότε. Οι αλλαγές που έχουν γίνει μετα την αγορά του ειναι: Προσθήκη SSD και Υδρόψυξης Upgrade των Windows 7 σε 8.1 αργότερα σε 10

"About two months ago, I bought a pot from IKEA that made by stainless steel 205 35" About two months ago, I bought a pot from IKEA that made by stainless steel 205 35

Εγγύηση εφόρου ζωής μόνο μια μάρκα υπάρχει AMC. Τις είχε πάρει η Μητέρα μου πριν σαράντα+ χρόνια και τις έχω εγώ τώρα. (ένα fissler της ίδιας εποχής δεν αντεξε ούτε τα μισά χρόνια των AMC) Το υλικό είναι κράμα χάλυβα με χρώμιο και νικέλιο (AISI304 -X5CrNi18-10) ή απλά Inox 18/10. Ο πάτος των AMC είναι οκταμερές κράμα χάλυβα πατέντα της AMC. Τα υπόλοιπα σκεύη της AMC (δίσκοι, μπολ κλπ) είναι από 18/8 Ακόμα και να αφήσεις το φαγητό να καεί (να σωθεί το νερό) τα σκεύη δεν παθαίνουν σχεδόν τίποτα και αναλόγως πόση ώρα πέρασε χωρίς νερό θέλει και ανάλογο τρίψιμο μετά για να γίνουν όπως πριν και ίσως να τα περάσεις με μια «κρέμα» για να γυαλίσουν σε περίπτωση που θαμπώσουν (σπάνιο φαινόμενο μετά από ώρα/ες πάνω στο μάτι). Το μόνο πρόβλημα είναι το κόστος.

Click on [More Borders] ...

Τι ευσταθεί επιστημονικά ότι το διοξείδιο είναι ανθρωπογενές ή/και ότι είναι ρύπος ?