Ανοιγμα αρχειου excel μεσα απο excel και μακροεντολες

Axelfc · 17 Απριλίου 2008

Για να γινω πιο κατανοητος τι ακριβως θελω να κανω. Εστω οτι εχουμε σε ενα αρχειο excel 2 στηλες η πρωτη με ονοματα μεταβλητων και η δευτερη με καποιες τιμες τους. Στη συνεχεια εχω ενα δευτερο αρχειο excel στο οποιο θελω με καποιο τροπο να περασω τις τιμες των μεταβλητων του πρωτου αρχειου και να γινονται καποιες πραξεις.

Υπαρχει περιπτωση να γινει κατι τετοιο με τη visual basic που εχει το excel? Να μου πεταει καποιο popup πχ και να δινω σαν Input στο δευτερο αρχειο το πρωτο αρχειο και στη συνεχεια να γινεται η επεξεργασια.

Sorry αν σας μπερδεψα..

kostassid · 17 Απριλίου 2008

ανετα... πατας το "= " στο κελι που θες την τιμη απο το πρωτο λογιστικο φυλλο και μετα enter, αλλα ΠΡΟΣΟΧΗ μεγαλη... αν αλλαξεις αργοτερα ονομα στο αρχειο απο οπου παιρνεις τα δεδομενα η του αλλαξεις directory τοτε χανεται και η τιμη γιατι:

Με το ισον του δινεις ενα στοχο και κοιταει εκει συνεχεια, ειναι δυναμικο, αν το αλλαξεις τοτε αλλαζει και στο δευτερο αρχειο, αν δε θες να αλλαζει κανε απλα ενα copy ...paste special...values για να μην κουβαλας συναρτησεις μονες τους

οτι αλλο θες...εισαι τυχερος που εχω αυπνιες(insomnia)

Axelfc · 18 Απριλίου 2008

Σ'ευχαριστω για την απαντηση. Δεν ηξερα οτι γινεται αυτο. Δυστυχως εγω δεν ειχα καθολου αυπνιες.

Λοιπον, το κακο με την ολη υποθεση ειναι πως ειναι πιο περιπλογο το θεμα. Τα ονοματα και η θεση των αρχειων θα αλλαζουν καθημερινα. Γι'αυτο ηθελα με καποιο τροπο να μπορω να δινω τη διαδρομη του αρχειου. Το κακο ειναι πως αυτο που θελω να κανω ειναι ακομα πιο πολυπλοκο. Δεν ξερω αν μπορει να γινει στο excel σιγουρα.

Για να γινω πιο κατανοητος. Εστω οτι εχουμε τα παρακατω 3 αρχεια.

1ο αρχειο:

Ονοματα Ναι Οχι

Κωστας 0 0

Γιωργος 0 0

Μαρια 0 0

Νικος 0 0

Ζωη 0 0

2ο αρχειο:

Κωστας ΝΑΙ

Γιωργος ΝΑΙ

Οταν δωσω το 2ο αρχειο σαν input στο 1ο θα δει οτι ο Κωστας και ο Γιωργος εχουν ΝΑΙ και θα αυξησει αντιστοιχα τον αριθμο των ΝΑΙ τους κατα 1. Στη συνεχεια καινουργιο αρχειο.

3ο αρχειο:

Κωστας ΟΧΙ

Μαρια ΝΑΙ

ΖΩΗ ΟΧΙ

Θα διαβασει το 3ο αρχειο και αντιστοιχα θα αυξησει αναλογα τον αριθμο των ΝΑΙ και ΟΧΙ του καθε ατομου. Καθε μερα θα δημιουργουνται καινουργια αρχεια και οι εγγραφες τους θα περνιουνται στο 1ο αρχειο.

Παιζει κατι τετοιο στο excel? Δεν με πειραζει να το κανω και σε καποια αλλη γλωσσα προγραμματισμου, αρκει το input αρχειο να ειναι excel η doc. Καθε ιδεα δεκτη.

kostassid · 18 Απριλίου 2008

Λοιπον:1) Ειναι απαραιτητο να εχεις 3 αρχεια? δε μπορεις worksheets για μεγαλυτερη ευκολια?

2) Μπορεις να προσθετεις κατα μερα ( οριζοντια ) και κατα μηνα, το συνολικο αθροισμα , στη κατακορυφη

3)Μπορεις να κανεις εξυπνη αντιγραφη στα επομενα κελια και να πίρνουν αυτόματα τη τιμη δηλαδη

1ο αρχειο ονομα

γραμμη α ναι α1 α2 α3 α4 α5 α6 α7 α8 α9....(κενα κελια)

γραμμη β Κωστας

γραμμη γ οχι γ1 γ2 γ3 γ4 γ5 γ6 γ7 γ8 γ9 ....(ομοιως)

ναι

Νικος

οχι

2ο αρχειο ονομα

Κωστας =α1, =α2, =α3 ....

= γ1 , =γ2, =γ3 ....

δε ξερω αν σε καλυπτω, δε μπορω να καταλαβω ΑΚΡΙΒΩΣ αυτο που θελεις αλλα αν εξηγησεις κατι παραπανω...προγραμματισμο δεν ξερω.

teodkats · 19 Απριλίου 2008

Για να γινω πιο κατανοητος τι ακριβως θελω να κανω. Εστω οτι εχουμε σε ενα αρχειο excel 2 στηλες η πρωτη με ονοματα μεταβλητων και η δευτερη με καποιες τιμες τους. Στη συνεχεια εχω ενα δευτερο αρχειο excel στο οποιο θελω με καποιο τροπο να περασω τις τιμες των μεταβλητων του πρωτου αρχειου και να γινονται καποιες πραξεις.

Υπαρχει περιπτωση να γινει κατι τετοιο με τη visual basic που εχει το excel? Να μου πεταει καποιο popup πχ και να δινω σαν Input στο δευτερο αρχειο το πρωτο αρχειο και στη συνεχεια να γινεται η επεξεργασια.

Sorry αν σας μπερδεψα..

Δεν κατάλαβα τι ακριβώς θέλεις να κανείς αλλά οι έτοιμες συναρτήσεις VLOOKUP και IF σε συνδυασμό σε καλύπτουν νομίζω, αλλιώς δημιούργησε δικιά σου σε visual basic ή κάποια μαρκοεντολή μήπως κανείς την δουλεία σου.

Ελπίζω να βοήθησα..

Axelfc · 19 Απριλίου 2008

Σ'ευχαριστω για τη βοηθεια kostassid, αλλα τελικα βρηκα τροπο να ανοιγω καθε φορα το αρχειο που θελω μεσα απο pop up window στη Visual Basic.

Τωρα εχω κολλησει καπου αλλου. Για να αποφυγω τα πολλαπλα loops εψαχνα για καποια εντολη της VB που να μου δινει κατευθειαν το index ενος στοιχειου σε εναν πινακα. Δλδ αν πχ εχω το ονομα Κωστας το προγραμμα να μην ψαχνει ολη τη λιστα με τα ονοματα, αλλα να μου δινει καποια εντολη τη θεση του ονοματος αυτου μεσα στον πινακα.

myIndex = (Array.IndexOf(myArray,"name"))

Αυτη ειναι η εντολη που υποτιθεται οτι κανει αυτη τη δουλεια, αλλα ο compiler μου πεταει σφαλμα πω λειπει ( στην . διπλα στον Array. Εψαξα και ειδα πως η εντολη Array ειναι κομματι του .NET Framework και συγκεκριμενα το compile απαιτει

Access to Mscorlib.dll and the System namespace. οπως γραφει εδω http://msdn2.microsoft.com/en-us/library/c7cdd1d1(VS.80).aspx

Εγκατεστησα το .NET Framework και απο τα Tools -> References της Visual Basic επελεξα το mscorlib.dll και το System. Ωστωσω και παλι παιρνω το ιδιο error.

Τι κανω λαθος?

bilco · 19 Απριλίου 2008

Δεν δουλεύει το .net με τη vba. Αυτό που μπορείς να κάνεις είναι να χρησιμοποιήσεις την Application.WorksheetFunctions.Match. Ωστόσο έχει πολλά προβλήματα και θα σου πρότεινα ή να χρησιμοποιήσεις το scripting dictionary * ή να κρατάς ταξινομημένα τα ονόματα στο συγκεντρωτικό αρχείο ώστε με ένα binarysearch να βρίσκεις σχετικά γρήγορα αυτό που θέλεις. Με το dictionary αργείς στο initialization αλλά έχεις πολύ γρηγορότερη αναζήτηση, οπότε ανάλογα με τη χρήση διαλέγεις.

Αν θέλεις πάντως δείξε τι έχεις κάνει μέχρι τώρα, για να βοηθήσω όσο μπορώ.

*

>
Set dic = CreateObject("Scripting.Dictionary")
dic.Add "one", 15
dic.Add "two", 21
MsgBox dic("two")

Axelfc · 20 Απριλίου 2008

Οριστε ο κωδικας που εχω γραψει ως τωρα:

>
Dim ExcelApp As Excel.Application
Dim ExcelWorkbook As Excel.Workbook
Dim ExcelSheet As Excel.Worksheet
Dim MyFileName As String
Dim arrayOnomata(3) As String
Dim arrayOptions(2) As String
Sub Check()

'Onomata
arrayOnomata(1) = "Κώστας"
arrayOnomata(2) = "Νίκος"
arrayOnomata(3) = "Μαρία"

'Options
arrayOptions(1) = "Ναι"
arrayOptions(2) = "Όχι"

'Open Dialog Box
MyFileName = Application.GetOpenFilename("Αναφορά (*.xls), *.xls")
Range("A1").Value = MyFileName

'Open Anafora
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Open(MyFileName)
Set ExcelSheet = ExcelWorkbook.Worksheets(1)

'Check Options
If ExcelApp.Range("A1").Value = arrayOnomata(1) Then
   If ExcelApp.Range("B1").Value = arrayOptions(1) Then
       Range("B4").Value = Range("B4").Value + 1
   ElseIf ExcelApp.Range("B1").Value = arrayOptions(2) Then
       Range("C4").Value = Range("C4").Value + 1
   End If
End If

'Close Excel file
ExcelWorkbook.Close savechanges:=False
ExcelApp.Quit
Set ExcelApp = Nothing
Set ExcelWorkbook = Nothing
Set ExcelSheet = Nothing
       
End Sub

Ουσιαστικα το κομματι που μενει να υλοποιηθει ειναι αυτο στο Check Options. Επειδη ο αριθμος των συνολικων ονοματων θα ειναι ~40 και η καθε αναφορα θα εχει εναν αριθμο ονοματων απο 0 εως 40 με πολλαπλα loops θα παιρνει πολυ χρονο και πολλες γραμμες κωδικα για να βρισκω καθε φορα το ονομα. Γι'αυτο ψαχνω εναν πιο γρηγορο τροπο.

Στα attachements εχω βαλει τα 2 αρχεια excel που κανω δοκιμες. Στο check.xls θα γινεται ο ελεγχος. Αν το ανοιξετε και τρεξετε τη VBA που εχω ενσωματωσει θα πεταξει ενα παραθυρο στο οποιο θα ζητησει ενα αρχειο σαν input. Επιλεξτε το 2ο αρχειο anafora.xls. Για την ωρα το εβαλα να ελεγξει μονο το 1ο ονομα. Πριν αρχισω τα loops ειπα μηπως υπαρχει γρηγοροτερος τροπος..

Ευχαριστω για τη βοηθεια!

insomnia.zip

bilco · 20 Απριλίου 2008

Το παρακάτω είναι με τη λογική ότι το αρχείο αναφοράς δεν περιέχει απαραίτητα όλα τα ονόματα και με την ίδια σειρά που εμφανίζονται στο αρχείο check (αν συμβαίνει κάτι τέτοιο είναι πολύ πιο εύκολα τα πράγματα)

>
' Εδώ ξεκινάμε
Sub start()
   Check "A1", "A3:C6"
End Sub

Sub Check(ByRef inputFirstCell As String, ByRef outRange As String)
' inputFirstCell: το πρώτο κελί με όνομα στο αρχείο αναφοράς
' outRange: η περιοχή με τα ονόματα και τα σύνολα των ναι-οχι(συμπεριλαμβάνουμε και
' την πρώτη γραμμή με τις επικαφαλίδες ναι, όχι)

   Dim names As Object, rng As Range, i As Long, fileName As Variant
   Dim options(1 To 2) As String, book As workbook
   
   On Error GoTo INIT_ERROR
   Set rng = Application.ActiveWorkbook.Worksheets(1).Range(outRange)
   ' Διαβάζουμε τα δύο options
   options(1) = rng(1, 2).Value
   options(2) = rng(1, 3).Value
   ' Κρατάμε για κάθε όνομα στο check τον αριθμό γραμμής του στην περιοχή
   Set names = CreateObject("Scripting.Dictionary")
   For i = 2 To rng.Rows.Count
       names.Add rng(i, 1).Value, i
   Next i
   
   While (True)
       fileName = Application.GetOpenFilename("XL files(*.xls), *.xls")
       ' Έξοδος αν πατήσουμε cancel στο διάλογο
       If (fileName = False) Then
           Exit Sub
       End If
       On Error GoTo OPF_ERROR
       ' μόνο για ανάγνωση και το κρύβουμε
       Set book = Application.Workbooks.Open(fileName, ReadOnly:=True)
       book.Windows(1).Visible = False
       On Error GoTo PROC_ERROR
       ProcWorkbook book, inputFirstCell, rng, names, options
       book.Close False
   Wend
   
   Exit Sub
INIT_ERROR:
   MsgBox "Failed to initialize", vbCritical, "Error"
   Exit Sub
OPF_ERROR:
   MsgBox "Failed to open " & fileName, vbCritical, "Error"
   Exit Sub
PROC_ERROR:
   book.Close False
   MsgBox "Failed to proccess " & fileName, vbCritical, "Error"
   
End Sub

Sub ProcWorkbook(ByRef book As workbook, ByRef inputFirstCell As String, ByRef outRange As Range, _
   ByRef names As Object, ByRef options() As String)
   
   Dim rng As Range, row As Long, col As Long, i As Long, k As Long, nm As String
   
   Set rng = book.Worksheets(1).Cells
   ' βρίσκουμε τον αριθμό γραμμής και στήλης του πρώτου κελιού
   row = rng.Range(inputFirstCell).row
   col = rng.Range(inputFirstCell).Column
   
   ' Κατεβαίνουμε μέχρι να βρούμε κενό κελί
   nm = rng(row, col).Value
   i = 0
   While (nm <> "")
       ' αν το όνομα υπάρχει στο check
       If (names.Exists(nm)) Then
           k = names(nm) ' βρίσκουμε τον αριθμό γραμμής του στο check
           ' και ανάλογα με τα options αυξάνουμε
           If (StrComp(rng(row + i, col + 1).Value, options(1), vbTextCompare) = 0) Then
               outRange(k, 2).Value = outRange(k, 2).Value + 1
           ElseIf (StrComp(rng(row + i, col + 1).Value, options(2), vbTextCompare) = 0) Then
               outRange(k, 3).Value = outRange(k, 3).Value + 1
           End If
       End If
       ' πάμε στο επόμενο
       i = i + 1
       nm = rng(row + i, col).Value
   Wend
   
End Sub

Axelfc · 20 Απριλίου 2008

Σ'ευχαριστω πολυ για το χρονο σου και τον κοπο σου bilco! Θα διαβασω τον κωδικα σου και θα ενημερωσω για το αποτελεσμα.

Axelfc · 30 Απριλίου 2008

Με καποια καθυστερηση τροποποιησα λιγακι τον κωδικα σου bilco ωστε να μη χρειαζεται να δωσεις ως input range την περιοχη που βρισκονται τα ονοματα. Ο λογος ειναι να μη χρειαζεται επεμβαση στον κωδικα αν προστεθει η αφαιρεθει καποιο ονοματα απο τη λιστα στο αρχειο check.

Τωρα πρεπει να βρω εναν τροπο το range που βρεθηκε να μπαινει ως input στη συναρτηση ProcWorkbook για να αυτοματοποιηθει και αυτη.

Επισης κατι απο αλλο που σκεφτομαι αν μπορει να γινει ειναι πριν περαστουν τα αποτελεσματα του ελεγχου στο αρχειο check να βγαινει ενα popup που να λεει "Αυτα ειναι τα παρακατω αποτελεσματα. Να τα περασω? Ναι/Οχι" Θελω δλδ να βρω εναν τροπο να αποφυγω να μην υπολογιστει καποια εγγραφη εξαιτιας ορθογραφικου λαθους.

Οριστε και ο τροποποιημενος κωδικας.

>
' Εδώ ξεκινάμε
Sub start()
   Check "A1", "A3:C6"
End Sub

Sub Check(ByRef inputFirstCell As String, ByRef outRange As String)
' inputFirstCell: το πρώτο κελί με όνομα στο αρχείο αναφοράς
' outRange: η περιοχή με τα ονόματα και τα σύνολα των ναι-οχι(συμπεριλαμβάνουμε και
' την πρώτη γραμμή με τις επικαφαλίδες ναι, όχι)

   Dim names As Object, rng As Range, i As Long, fileName As Variant
   Dim options(1 To 2) As String, book As Workbook
   
   On Error GoTo INIT_ERROR
   Set rng = Application.ActiveWorkbook.Worksheets(1).Range(outRange)
   ' Διαβάζουμε τα δύο options
   options(1) = rng(1, 2).Value
   options(2) = rng(1, 3).Value
   
   Dim nameList As Range, nameCnt As String, row As Long, col As Long, j As Long
   ' row,col : Το 1ο Cell που εμφανιζεται ονομα στην κατασταση ονοματων
   row = 4
   col = 1
   Set nameList = Application.ActiveWorkbook.Worksheets(1).Cells
   nameCnt = nameList(row, col).Value
   ' j : Το πληθος των ονοματων
   j = 0
   While (nameCnt <> "")
       j = j + 1
       nameCnt = nameList(row + j, col).Value
       'MsgBox nameCnt
   Wend
       
   ' Κραταμε για καθε ονομα στο check τον αριθμο γραμμης του στην περιοχη
   Set names = CreateObject("Scripting.Dictionary")
   For i = 0 To j
   MsgBox i & " " & nameList(row + i, 1).Value
           names.Add nameList(row + i, 1).Value, i + 2
   Next i
   
   'While (True)
       fileName = Application.GetOpenFilename("XL files(*.xls), *.xls")
       ' Έξοδος αν πατήσουμε cancel στο διάλογο
       If (fileName = False) Then
           Exit Sub
       End If
       On Error GoTo OPF_ERROR
       ' μόνο για ανάγνωση και το κρύβουμε
       Set book = Application.Workbooks.Open(fileName, ReadOnly:=True)
       'book.Windows(1).Visible = False
       On Error GoTo PROC_ERROR
       ProcWorkbook book, inputFirstCell, rng, names, options
       book.Close False
   'Wend
   
   Exit Sub
INIT_ERROR:
   MsgBox "Failed to initialize", vbCritical, "Error"
   Exit Sub
OPF_ERROR:
   MsgBox "Failed to open " & fileName, vbCritical, "Error"
   Exit Sub
PROC_ERROR:
   book.Close False
   MsgBox "Failed to proccess " & fileName, vbCritical, "Error"
   
End Sub

Sub ProcWorkbook(ByRef book As Workbook, ByRef inputFirstCell As String, ByRef outRange As Range, _
   ByRef names As Object, ByRef options() As String)
   
   Dim rng As Range, row As Long, col As Long, i As Long, k As Long, nm As String
       
   Set rng = book.Worksheets(1).Cells
   ' βρισκουμε τον α
   row = rng.Range(inputFirstCell).row
   col = rng.Range(inputFirstCell).Column
   
   ' κατεβαινουμε μεχρι να βρουμε κενο κελι
   nm = rng(row, col).Value
   i = 0
   While (nm <> "")
       ' αν το ονομα υπαρχει στο check
       If (names.Exists(nm)) Then
           k = names(nm) ' βρισκουμε τον αριθμο γραμμης του στο check
           ' και αναλογα με τα options αυξανουμε
           If (StrComp(rng(row + i, col + 1).Value, options(1), vbTextCompare) = 0) Then
               outRange(k, 2).Value = outRange(k, 2).Value + 1
           ElseIf (StrComp(rng(row + i, col + 1).Value, options(2), vbTextCompare) = 0) Then
               outRange(k, 3).Value = outRange(k, 3).Value + 1
           End If
       End If
       ' παμε στο επομενο
       i = i + 1
       nm = rng(row + i, col).Value
   Wend
   
End Sub

Σύνδεση

Ανοιγμα αρχειου excel μεσα απο excel και μακροεντολες

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

Axelfc

kostassid

Axelfc

kostassid

teodkats

Axelfc

bilco

Axelfc

bilco

Axelfc

Axelfc

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

Σύνδεση