Βοήθεια με VBA σε EXCEL

[Infotech]

Χαιρετώ σας!

Θα ήθελα λίγη βοήθεια σε ένα θεματάκι όσον αφορά την μετατροπή ενός αλγόριθμου που έφτιαξα στο Excel. Επειδή δεν μπορώ κάθε φορά να κάνω copy paste και να μου χαλάνε διάφορα references  σε  cells θέλω να γράψω τον αλγόριθμο που έφτιαξα σε VBA function και να το αποθηκεύσω ώστε να μπορώ να το χρησιμοποιώ σαν απλή function του Excel.

 

Δυστυχώς έχουν περάσει αρκετά χρόνια από την τελευταία φορά που έγραψα VB αντιμετωπίζω κάποια προβλήματα που θα ήθελα μία βοήθεια.

 

Κατ'αρχάς ο αλγόριθμος είναι ο εξής:

=HLOOKUP(C2;IF(D2<0,3;'TR.xlsm'!TABLE02;'TR.xlsm'!TABLE03);MATCH(B2; RTABLES !$A$4:$A$7)+1;FALSE)

 

Το παραπάνω μου δουλεύει μιά χαρά.

 

Το πρόβλημα όμως είναι στην υλοποίηση που έκανα σε VBA.

Άνοιξα VBA στο Excel και έκανα δημιουργία ενός module και έγραψα το παρακάτω:

 

Function rpclc(CLRT, CLR, WT) As Single

 

Dim wtable As Range
Dim Vclt, Vclr As String
Dim Vw As Single
Dim ClrRow As Integer

 

Vw = WT
 Vclr = CLR
 Vclt = CLRT

 

If Vw > 0.2 Then
    Set wtable = Sheets("RTABLES").Range("B3:E7")
ElseIf w > 0.3 Then
    Set wtable = Sheets("RTABLES").Range("G3:J7")
Else
    Set wtable = Sheets("RTABLES").Range("b3:e7")
End If

 

ClrRow = Application.WorksheetFunction.Match(Vclr, Sheets("RTABLES").Range("A4:A7") + 1)

rpclc = Application.WorksheetFunction.HLookup(Vclt, wtable, ClrRow, 0)

 

End Function

 

Δεν ξερω για ποιό λόγο δεν μου δουλεύει. Δεν επιστρέφει καμία τιμή. Σίγουρα κάτι δεν κάνω καλά στις δηλώσεις των Ranges.

 

Όποιος μπορεί ας βοηθήσει. Ευχαριστώ!

 

 

[Wizard!]

Έχω να γράψω χρόνια VBA, αλλά στα γρήγορα αυτό που βλέπω είναι πως δεν έχεις ορίσει τη μεταβλητή w, οπότε μάλλον σκάει.

 

Quote

If Vw > 0.2 Then
    Set wtable = Sheets("RTABLES").Range("B3:E7")
ElseIf w > 0.3 Then
    Set wtable = Sheets("RTABLES").Range("G3:J7")
Else
    Set wtable = Sheets("RTABLES").Range("b3:e7")
End If

 

edit: Επίσης, αν εκεί θέλεις να δεις τη Vw, δε θα μπει ποτέ στο ElseIf, αφού αν είναι > 0.3, θα είναι και > 0.2, οπότε θα μπαίνει στην πρώτη διακλάδωση.

 

[Infotech]

Σωστά! θα το διορθώσω αλλά το θέμα είναι ότι και στο πρώτο if που μπαίνει δεν μου δουλεύει.

[Wizard!]

Διορθώνεις πρώτα και debug μετά

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

[Infotech]

Λοιπόν έγινε το εξής αλλά πάλι αποτέλεσμα δεν παίρνω

 

If (Vw > 0.2) And (Vw < 0.299) Then
    Set wtable = Sheets("RTABLES").Range("B3:E7")
ElseIf (Vw > 0.3) And (Vw < 0.399) Then
    Set wtable = Sheets("RTABLES").Range("G3:J7")
Else
    Set wtable = Sheets("RTABLES").Range("b3:e7")
End If

[Wizard!]

Βάλε debug info ανάμεσα να δεις τι κάνει. Θεωρητικά θα μπει στο Else όπως και να έχει.

 

rpclc = 1
If (Vw > 0.2) And (Vw < 0.299) Then
    Set wtable = Sheets("RTABLES").Range("B3:E7")
    rpclc = 2
ElseIf (Vw > 0.3) And (Vw < 0.399) Then
    Set wtable = Sheets("RTABLES").Range("G3:J7")
    rpclc = 3
Else
    Set wtable = Sheets("RTABLES").Range("b3:e7")
    rpclc = 4
End If

Ανάλογα με την τιμή που θα πάρεις (βάλε ότι σε βολεύει εκεί),  θα δεις που μπήκε.

Αν δεν πάρεις καμία από αυτές, τότε το λάθος σου είναι στις δύο τελευταίες.

[Infotech]

Το είχα κάνει αυτό για να δω σε ποιά if μπαίνει και τι τιμή δίνει πριν φτάσει στο τέλος και είχα βάλει και breakpoints σε διάφορα σημεία για να βλέπω τι τιμές δίνει.  Όταν μπαίνει στην if παίζει κανονικά, μετά μάλλον την χαλάει κάτι που ίσως δεν γράφω σωστά στους ορισμούς των ranges.

[Wizard!]

Το ClrRow παίρνει τιμές; Έχεις τρόπο να το δεις;

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

[Infotech]

Βασικά εκτός των απλών μεταβλητών που δουλεύουν σωστά δεν μπορώ να ελέγξω τις άλλες (clrrow, wtable) γιατί ενώ έχω βάλει breakpoints στις γραμμές τους φαίνεται ότι εκεί δεν γίνεται κάτι οπότε και το compile τερματίζει απλά προσπερνώντας τες.

 

Υποψιάζομαι ότι κάτι δεν κάνω καλά στην χρήση και κλήση των πινάκων.

Για παράδειγμα αν είχατε αυτό (χωρίς τα IF):

=HLOOKUP(C2;'TR.xlsm'!TABLE02;MATCH(B2; RTABLES !$A$4:$A$7)+1;FALSE)

 

Πώς θα το υλοποιούσατε;

Φαντάζομαι πως είναι κάτι πολύ απλό απλά κάποια λεπτομέρεια τεχνική ως προς την κλήση των πινάκων δεν κάνω καλά.

[nucleus]

Εγώ πάλι απο εδώ https://msdn.microsoft.com/en-us/library/office/ff838238%28v=office.14%29.aspx σε όποια version και να το βάλεις βάζει

 

Παράθεση

Worksheets("Sheet1")

και όχι Sheets επίσης το Range τα ορίζει όπως το κάνεις και εσύ

 

Παράθεση

Worksheets("Sheet1").Activate

Range("A1:H8").Formula = "=Rand()" 'Range is on the active sheet

με A1:H8 πχ μήπως να δοκιμάσεις με την Activate πρώτα και μετά το Range, δηλαδή αντι για

Set wtable = Sheets("RTABLES").Range("B3:E7")

να το κάνεις ως εξής

Worksheets("RTABLES").Activate

Set wtable = Range("B3:E7")

EDIT: Θεωρητικά θα μπορούσες το Activate να το κάνεις μια φορά πριν τα If - ElseIf - Else και μετά απλώς να βάζεις τα Range

 

EDIT2:More info https://msdn.microsoft.com/en-us/library/office/ff836512.aspx

[Infotech]

Κατ' αρχήν να ευχαριστήσω για τον χρόνο σας.

 

Λοιπόν δοκίμασα να κάνω Worksheets("RTABLES").Activate αλλά παρατήρησα ότι όχι μόνο δεν μου δούλευε πάλι αλλά είχα και τελείως διαφορετική αντιμετώπιση στον υπολογισμό της ClrRow.

Επειδή όμως και activate να μην είχα κάνει αρκεί να δηλώσω όλο το worksheet().range() οπότε και δεν υπήρχε πρόβλημα.

 

Το πρόβλημα λύθηκε πολύ απλά βάζοντας τις δύο παρακάτω γραμμές εντός των IF  και επιπροσθέτως (ίσως όχι απαραιτήτως) ορίζοντας tables από το Excel (τα κρατάει σαν αντικείμενα).

 

ClrRow = Application.WorksheetFunction.Match(Vclr, Worksheets("RTABLES").Range("clrtable")) + 1
    rpclc = Application.WorksheetFunction.HLookup(Vclt, Worksheets("RTABLES").Range("table02"), ClrRow, 0)

 

Ιδού και το τελικό για τα πρακτικά και για όποιον θέλει να εξασκηθεί:

 

Function rpclc(CLRT, CLR, WT)

Dim Vclt, Vclr As String
Dim Vw As Single
Dim ClrRow As Integer

 

Vw = WT
 Vclr = CLR
 Vclt = CLRT

 

If (Vw >= 0.2) And (Vw < 0.299) Then
   

    ClrRow = Application.WorksheetFunction.Match(Vclr, Worksheets("RTABLES").Range("clrtable")) + 1
    rpclc = Application.WorksheetFunction.HLookup(Vclt, Worksheets("RTABLES").Range("table02"), ClrRow, 0)

 

Else

rpclc="No Data from Tables"
    If (Vw >= 0.3) And (Vw < 0.399) Then

       ClrRow = Application.WorksheetFunction.Match(Vclr, Worksheets("RTABLES").Range("clrtable")) + 1
        rpclc = Application.WorksheetFunction.HLookup(Vclt, Worksheets("RTABLES").Range("table03"), ClrRow, 0)

    end if
End If

 

End Function