Προς το περιεχόμενο

Προβλημα με macro


angalt

Προτεινόμενες αναρτήσεις

Δημοσ.

Καλημέρα/σπέρα.

Χρειάζομαι βοηθεια όσον αφορά προγραμματισμο.

πρεπει να φτιάξω για την δουλεία μου (πολυ σοβαρο) ενα ecxeλακι οπου θα κανει κατι σαν copy-paste απο ενα φύλλο εργασιας (σαν φοραμ ερωτησεων) σε ενα αλλο φυλλο που θα ειναι συγκεντροτικος πινακας.

 

Π.Χ.

 

Φυλλο1:

 

ονομα ημερομηνια ποσο πληρωμης

 

ΑΠΟ ΚΑΤΩ ΘΑ ΕΧΕΙ ΚΟΥΤΙΑ ΠΟΥ ΘΑ ΣΥΜΠΛΗΡΩΝΩ ΚΑΘΕ ΦΟΡΑ ΝΕΑ ΣΤΟΙΧΕΙΑ.

 

Φύλλο2:

 

Πίνακας

 

ονομα / ημερομηνια / ποσο πληρωμης / (αν γινεται να εχει και ημ/νια καταχωρησης διπλα)

 

και διπλα στον πινακα να εχει ενα button που θα με πηγαινει σε ενα διαγραμμα με ημ/νια-ποσο πληρωμης για συναρτησεις.

 

 

Αυτό που θέλω ειναι λοιπον στο Φύλλο1 να καταχωρω καθε φορα νέα στοιχεια (οχι σε πινακα αλλα σε ενα πλαισιο που καθε φορα θα σβηνεται) και αυτα τα δεδομενα με ενα button να πηγενουν στο αλλο φυλλο (φυλλο2) οπου θα ταξινομουντε σε εναν πινακα.

 

Παιδια αν μπορειτε να βοηθησετε ειναι πολυ σημαντιο.

 

Ευχαριστω

Δημοσ.

Βασικα δεν πολυκαταλαβα.....Αν ειναι ευκολο ενας να μου γραψει τον κωδικο να τον παρω copy-paste γιατι το κεφαλι μου εγινε καζανι.

Δημοσ.

Καταλαβαινω οτι αυτο που ζηταω ειναι βαρετο-πονοκεφαλος και γιαυτο ζηταω συγνωμη απλα ειναι αναγκη διοτι πρεπει μεχρι τις 2.30 να το εχω σχεδον κανει και τα εχω παιξει. Προσπαθω μαυτο που μου εδωσες να το κανω αλλα κολαω σε κατι εντολες και αλλαζω. Γιαυτο ζηταω αν γινεται να το κανει ενας. Ενας που γνωριζει καλα δεν θα εχει προβλιμα σε30' να το κανει. Απλα το χρειαζομαι αν ειναι ευκολο.

Δημοσ.

κατι δεν μου βγαινει. Περνω αυτο που μου ειπ[ες, αλλαζω τα κελια και οπου εχει workgroop βαζω sheet

 

αλλα μου βγαζει λαθος

 

---------- Το μήνυμα προστέθηκε στις 13:49 ----------

 

Μπορεσε κανεις να το κανει? Παιδια βοηθεια αν μπορειτε ειναι αναγκη.

μου βγαζει συνεχεια error 9 και αλλα.Ειναι αναγκη.

Δημοσ.

Private Sub CommandButton2_Click()

Dim x As Long

x = Worksheets("futured works").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("enter data").Range("A3:Z3").Copy

Worksheets("futured works").Range("A" & x + 1).PasteSpecial

Worksheets("enter data").Range("A3:Z3").ClearContents

MsgBox "Updated"

End Sub

 

 

Διαβαστε το...κατι λειπει γιατι στο 2ο φυλλο αντι να μου τα κανει paste το ενα κατω απο το αλλο μου τα κανει ολα σε ενα με αποτελεσμα να μου σβηνει το προηγουμενο.

Δημοσ.

Ο κώδικας που μας έδωσες δουλεύει αλλά δοκίμασε και αυτόν:

 

>Private Sub CommandButton2_Click()
   With Worksheets("enter data").Range("A3:Z3").Cells
       Worksheets("futured works").Cells(Rows.Count, 1) _
           .End(xlUp).Offset(1).Resize(, 26).Cells = .Value
       .ClearContents
   End With
   MsgBox "Updated"
End Sub

 

Υ.Γ.

Είναι 02:39. Προλαβαίνεις;:-)

Δημοσ.

καλημερα...μπααα,δεν προλαβα και τα ακουσα...και ακομα τα ακουω βασικα.

Παιδια θα σας δωσω ξανα τον κωδικα....εκτελεστε τον αλλλα πολλες φορες.....ενω μου τα κανει ολα σωστα......μετα απο καποια γραμμη (6-7) παυει να μου προσθετει τα δεδομενα στην απο κατω σειρα του πινακα.Σβηνει το προηγουμενο και βαζει το καινουργιο. Δειτε το αν μπορειτε να βγαλέτε ακρη.

Ευχαριστω.

 

Private Sub CommandButton1_Click()

Dim x As Long

x = Worksheets("futured works").Cells(Rows.Count, 1).End(xlUp).Row + 1

Worksheets("enter data").Range("B6:F6").Copy

Worksheets("futured works").Range("A" & x).PasteSpecial

Worksheets("enter data").Range("B6:F6").ClearContents

MsgBox "Updated"

End Sub

 

---------- Το μήνυμα προστέθηκε στις 10:28 ----------

 

Και κατι ακομα θελω......ενα κωδικα για γραφικη παρασταση.....

 

Button κλικ----περνει 2 στηλες και τις κανει Διαγραμμα σε ξεχωριστο φυλλο.

Δημοσ.

Φίλε angalt, ο κώδικας ψάχνει να βρει το τελευταίο μη κενό κελί

της στήλης "Α" του φύλλου "futured works".

 

Αν στη τελευταία εγγραφή του φύλλου το πρώτο αριστερό κελί είναι κενό

τότε ολόκληρη η εγγραφή αντικαθίσταται από τη νέα.

 

Οπότε ή φροντίζεις το πρώτο κελί της εγγραφής να μην είναι ποτέ κενό

ή χρησιμοποιείς άλλη μέθοδο εύρεσης της τελευταίας εγγραφής.

 

Εξέτασε τα παραπάνω και πες μας.

 

Υ.Γ.

Από ποιόν τα ακούς;:whistle:

Δημοσ.

Εκανα αυτο που μου ειπες με μερικες προσθαφαιρεσεις και μου βγηκε

 

Private Sub CommandButton2_Click()

With Worksheets("enter data").Range("A3:Z3").Cells

Worksheets("futured works").Cells(Rows.Count, 1) _

.End(xlUp).Offset(1).Resize(, 26).Cells = .Value

.ClearContents

End With

MsgBox "Updated"

End Sub

 

Ευχαριστω παρα πολυ. Τωρα ψαχνω εναν κωδικα για γραφημα...αλλα δεν μου κανουν αυτα που βρισκω....αν εχετε κανενα πειτε το.

 

Π.Σ. Αφεντικο....ηταν να το εχω χθες στις 2.30.....αργησα σχεδον 20 ωρες :)

Δημοσ.

Αχ αυτά τα αφεντικά! ...Τί σκότωμα θέλουν!:lol:

 

Δοκίμασε το παρακάτω παράδειγμα κώδικα για τη δημιουργία γραφήματος

και αν σε βολεύει προσάρμοσέ το στα μέτρα σου.

 

>Sub CreateNewChart()
   On Error Resume Next
   Application.DisplayAlerts = False
   Charts("MyNewChart").Delete
   Application.DisplayAlerts = True
   On Error GoTo 0
   
   Charts.Add
   With ActiveChart
       .ChartType = xlColumnClustered
       .SetSourceData _
           Source:=Sheets("futured works").UsedRange.Columns("A:C"), _
           PlotBy:=xlColumns
       .Location Where:=xlLocationAsNewSheet
       .Name = "MyNewChart"
       .HasTitle = False
       .Axes(xlCategory, xlPrimary).HasTitle = False
       .Axes(xlValue, xlPrimary).HasTitle = False
       .Move After:=Sheets(Sheets.Count)
   End With
End Sub

Αρχειοθετημένο

Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.

  • Δημιουργία νέου...