Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [Excel07] Eισαγωγή ημερομηνίας (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1435-eisagogi-imerominias.html)

jimrenoir 13-10-11 12:55

Eισαγωγή ημερομηνίας
 
Καλημέρα.
Σε ένα τμήμα κώδικα που μου έφτιαξε Ο Τάσος είναι macro σε excel πώς μπορώ να ορίζω την τιμή (ημερ/νια) που θα παίρνει στο συγκεκριμένο σημείο απο ένα κελί π.χ Α1 χωρίς να πιέζω τα πλήκτρα alt+f11και να γράφω μέσα στο σημείο του κώδικα την ημερομηνία που θέλω.
Σε αυτο το τμήμα θέλω να αλάζει η ημερομηνία ανάλογα με την επιλογη μου
Private Const DefaultURL = "URL;http://www.oddsfair.net/index.php?date=2011-10-13&league=%&order=timeasc"

gr8styl 14-10-11 18:30

Φίλε Δημήτρη
χωρίς να ξέρω για ποιόν κώδικα του Τάσου μιλάς,
στο ερώτημά σου Πώς γίνεται να αλλάζει η ημερομηνία θα σου έλεγα ότι πρώτα θα πρέπει αντί για σταθερά (CONST) να δηλώσεις την DefaultURL σαν μεταβλητή τύπου STRING
DIM DefaultURL as STRING
Στη συνέχεια μπορείς να καταχωρήσεις αυτό που θές σαν τιμή της μεταβλητής πχ
Κώδικας:

Dim DefaultURL As String

DefaultURL = "URL;http://www.oddsfair.net/index.php?date=" & _
    Year(Sheets(1).Range("c3").Value) & "-" & _
    Month(Sheets(1).Range("c3").Value) & "-" & _
    Day(Sheets(1).Range("c3").Value) & _
    "&league=%&order=timeasc"

όπου το Sheets(1).Range("c3") σημαίνει ότι θα διαβάζεται η ημερομηνία από το κελί c3 του πρώτου φύλλου.

Καλή συνέχεια.
Θανάσης

jimrenoir 14-10-11 21:17

Καλησπέρα σε όλο το φόρουμ.
Θανάση ευχαριστώ για την απάντηση.Σου παραθέτω τον κώδικα για να δείς.Και αν μπορείς να μου κάνεις αυτήν την διόρθωση
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private hwndHandle As Long, GWL_STYLE, frm As Long, hwndStyle As Long

Private Const DefaultURL = "URL;http://www.oddsfair.net/index.php?date=2011-10-13&league=%&order=timeasc"

Private Sub ImportDataFromWeb()
Dim OffsetX As String, i As Integer, LastRow As Integer
OffsetX = "&offset="
With BaseSheet
For i = 1 To 1
DoEvents
.QueryTables(1).Connection = DefaultURL
.QueryTables(1).Refresh BackgroundQuery:=False
SheetAllData.Range("A4:O5000").ClearContents
LastRow = 4
MergeData LastRow
LastRow = BaseSheet.Range("xPage").Rows.Count + 2
Next
i = 0
Do While .Range("xPage").Rows.Count > 2
DoEvents
i = i + 20
.QueryTables(1).Connection = DefaultURL & OffsetX & i
.QueryTables(1).Refresh BackgroundQuery:=False
MergeData LastRow
LastRow = LastRow + BaseSheet.Range("xPage").Rows.Count - 2
Loop
End With
End Sub

Tasos 14-10-11 21:43

Αγαπητέ Δημήτρη,

Το καταλαβαίνω ότι δεν σου είναι εύκολο να διαβάσεις κώδικα VBA.

Διάβασε τουλάχιστον αυτά που σου γράφουμε στα μηνύματα.

Αυτό που ζητάς βρίσκεται εδώ: http://www.ms-office.gr/forum/8305-post8.html

Διάβασε σε παρακαλώ προσεκτικά το μήνυμα αυτό και πάρε το συνημμένο που κάνει ακριβώς αυτό που ζητάς μέσα από τα Dropdown.

Στον κώδικα του συνημμένου βρες τις γραμμές:

Κώδικας:

    ShFirst.Range("A2:O1002").Value = ShSecond.Range("A4:O1004").Value
    ShSecond.Range("A2:O1002").Value = ShLast.Range("A4:O1004").Value
    ShLast.Range("A2:O1002").Value = SheetAllData.Range("A4:O1004").Value

και διέγραψε τις αν δεν θέλεις να αντιγράφονται τα δεδομένα στα φύλλα First, Second, Last.

Φιλικά

Τάσος

jimrenoir 14-10-11 22:28

Τάσο όχι απλώς δεν ξέρω (μου φαίνονται κινέζικα)
Που θα πάει όμως θα μάθω αγόρασα σήμερα το βιβλίο (VBA και Μακροεντολές για το excel 2007) Jeery Kohl
Ανεξάρτητα απο αυτό πάντως σας ευχαριστώ πάρα πολύ για την βοήθει που μου δίνεται
Απλά όταν αλλάζω το URl
private Const DefaultURL = "URL;http://www.oddsfair.net/index.php"
σε
Private Const DefaultURL = "URL;http://www.oddsfair.net/index.php?today()&league=%&order=timeASC"
(τα ταξινομή κατά ώρα)

σταματάει να λειτουργεί η ανανέωση για επιλογή ημέρας.οποια και αν επιλέξεις πάντα σου βγάζει την ίδια ημέρα.(δες το και θα καταλάβεις-εκτός και αν κάνω κάτι λάθος)
Τώρα θα μου πείς γιατι δεν βάζεις μια μακρο να τα ταξινομη μετα το update(δεν το κάνω γιατί χρησημοποιώ τύπους για υπολογισμο και μου μπλοκαρει)
Επίσης όταν τελειώνει το παιχνίδι το βγάζει απο την λίστα

Tasos 14-10-11 23:58

Δημήτρη,
η γραμμή που χρησιμοποιείς:
Κώδικας:

Private Const DefaultURL = "URL;http://www.oddsfair.net/index.php?today()&league=%&order=timeASC"
έχει σαν αποτέλεσμα η συνάρτηση να σου επιστρέφει πάντα δεδομένα από την τρέχουσα ημερομηνία ( βλ. today() ).

Άφησε το URL ως έχει δηλαδή: Private Const DefaultURL = "URL;http://www.oddsfair.net/index.php"
και ακριβώς από κάτω πρόσθεσε: Private Const SortOrder = "&order=timeASC"

Κατόπιν βρες τη γραμμή:
.QueryTables(1).Connection = DefaultURL & TheDate & League
και άλλαξε την σε:
.QueryTables(1).Connection = DefaultURL & TheDate & League & SortOrder

Έτσι θα έχεις και την ταξινόμηση.

Παράθεση:

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

Φιλικά

Τάσος

jimrenoir 18-10-11 02:00

ΕΥΧΑΡΙΣΤΩ
 
Τάσο είσαι άπεχτος δουλεύει τέλεια :drinking:


Η ώρα είναι 14:31.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2