Forum

Αναζήτηση στο ms-office.gr

Πάμε!

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 20-02-12, 12:27
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-09-2010
Περιοχή: Θεσσαλονίκη
Μηνύματα: 74
Προεπιλογή Λίστα ανά μήνα

Παρακαλώ την βοήθειά σας.
Στο επισυναπτόμενο αρχείο στο φύλλο εργασίας (Data) καταγράφω κάποιες δραστηριότητες ενός μηνός.
Στο δεύτερο φύλλο εργασίας (Update) μεταφέρω τα δεδομένα εκάστου μηνός με VBA .
Κώδικας:
Sub Items_per_Month()

Dim LastCell As Range
     
     Application.ScreenUpdating = False
     Application.Goto Reference:="Data"
    Selection.Copy
     Sheets("Update").Select
    With ActiveSheet
    Set LastCell = .Cells(.Rows.Count, "B").End(xlUp)
    If IsEmpty(LastCell) Then
    Else
      Set LastCell = LastCell.Offset(1, 0)
    End If
  End With
    
    LastCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    LastCell(2).Select
End Sub
Με τον παραπάνω κώδικα τα δεδομένα εισάγονται στο πρώτο κενό κελί της στήλης Β (LastCell).
Το ζητούμενο είναι το κελί εισαγωγής των δεδομένων να προσδιορίζεται συγκρίνοντας το κελί (Α1) με την περιοχή κελιών (Month) και να επιλέγεται το πρώτο κελί δεξιά στην στήλη Β, καθώς επίσης αν υπάρχουν ήδη δεδομένα σ’ αυτό το κελί να βγαίνει προειδοποιητικό μήνυμα του τύπου Yes/No αν θέλουμε να γίνει η ενημέρωση η όχι.
Σας ευχαριστώ εκ των προτέρων
Γιώργος
Συνημμένα Αρχεία
Τύπος Αρχείου: xls Update per months.xls (38,5 KB, 75 εμφανίσεις)
Απάντηση με παράθεση
  #2  
Παλιά 20-02-12, 16:51
Το avatar του χρήστη gr8styl
Super Moderator
Όνομα: Θανάσης Στυλιανίδης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-10-2009
Περιοχή: Βρυξέλλες, Βέλγιο
Μηνύματα: 823
Προεπιλογή

Φίλε Γιώργο,
Ο παρακάτω κώδικας κάνει νομίζω αυτό που θέλεις.
Κώδικας:
Sub Copy_month()
Dim LastCell As Range
  Application.ScreenUpdating = False
  Range("Data").Copy
  With Sheets("Update")
    Set LastCell = .Cells(Range("Months").Row - 1 + _
      Application.WorksheetFunction.Match(Range("A1").Value, Range("Months"), 0), "B")
    If IsEmpty(LastCell.Value) Then
      LastCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ElseIf MsgBox("Do you want to overwrite?", vbYesNo) = vbYes Then
      LastCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End If
    Application.CutCopyMode = False
  End With
  LastCell.Select
  Application.ScreenUpdating = True
End Sub
Δοκίμασέ το και πες μας.
Θανάσης
Απάντηση με παράθεση
  #3  
Παλιά 20-02-12, 18:43
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-09-2010
Περιοχή: Θεσσαλονίκη
Μηνύματα: 74
Προεπιλογή

Θανάση ευχαριστώ πολύ για την άμεση απάντηση
Κάνει ακριβώς το ζητούμενο.
Και πάλι ευχαριστώ πολύ.
Γιώργος
Απάντηση με παράθεση
  #4  
Παλιά 20-02-12, 19:31
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.159
Προεπιλογή

Καλησπέρα!
Φίλε Γιώργο δοκίμασε:

Κώδικας:
Sub SetValues()
    Dim rng As Range, rng1 As Range
    Set rng = Range("Months").Find(Range("Months").Parent.Range("A1"), , xlValues)
    If Not rng Is Nothing Then
        Set rng = rng.Offset(, 1).Resize(1, Range("Data").Columns.Count)
        On Error Resume Next
        Set rng1 = rng.SpecialCells(xlCellTypeConstants)
        If Not rng1 Is Nothing Then
            If MsgBox("Ο μήνας " & rng.Offset(, -1)(1) & " περιέχει ήδη δεδομένα!" & vbLf & _
                      "Θέλετε να ενημερώσετε τα δεδομένα αυτά;", vbYesNo + vbQuestion) <> vbYes Then
                Exit Sub
            End If
        End If
        rng.Value = Range("Data").Value
    End If
End Sub
Καλή συνέχεια!

Τάσος


Θανάση με πρόλαβες!
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word
Απάντηση με παράθεση
  #5  
Παλιά 23-02-12, 11:38
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-09-2010
Περιοχή: Θεσσαλονίκη
Μηνύματα: 74
Προεπιλογή

Τάσο σ ευχαριστώ κι εσένα
Το γεγονός ότι προλαβαίνει ο ένας τον άλλο δείχνει το μεγάλο ενδιαφέρον για τα προβλήματα των μέλων του Forum
Και πάλι σας ευχαριστώ
Γιώργος
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[ Ερωτήματα ] Εμφάνιση τρέχοντος μήνα dimitrisp Access - Ερωτήσεις / Απαντήσεις 4 12-09-16 09:11
[Συναρτήσεις] Συγκεντρωτικά στοιχεία μήνα. bill72 Excel - Ερωτήσεις / Απαντήσεις 8 08-07-16 21:37
[Συναρτήσεις] Eύρεση Μ.Ο. ανά μήνα ικεατη Excel - Ερωτήσεις / Απαντήσεις 28 27-02-12 09:27
[Συναρτήσεις] DATEDIF ανά μήνα shotcon Excel - Ερωτήσεις / Απαντήσεις 23 21-02-12 15:56
[Γενικά] Συγκεντρωτικό για όλο τον μήνα. misirlis Excel - Ερωτήσεις / Απαντήσεις 12 10-06-11 10:20


Η ώρα είναι 11:05.