Depanare program

[soltuz liliana]

Buna ziua,
as dori sa ma ajute cineva cu depanarea programului atasat.
El este preluat dintr-un basic si il vreau sa adaptez pentru access 2003
Multumesc

[alcoool2]

Salut!

Cea ce vrei tu este aproape imposibil pentru ca codul vba care ar trebui sa rezulte ar fi complet diferit - deci o adaptare nu prea ar merge. Ca sfat ar fi sa reconstruiesti totul de la 0 asa ca te rog sa incepi sa ne "povestesti" cam ce anume ar trebui sa faca aceasta baza de date si incet incet sa incepi sa o construiesti

[soltuz liliana]

Vad ca esti online "alcool", acest program este defapt un test sociometric.
Daca il rulezi poate iti dai seama cam ce vrea.
Se creaza o matrice cu preferinte si respingeri pentru persoanel dintr-un grup.
apoi se calculeaza un indice de preferinta s.a.
Multumesc daca te implici!

[alcoool2]

La prima vedere iti lipsea un end if

Cod: Selectaţi tot

Option Compare Database
Dim PREF(40, 40), PEXP(40), PPRIM(40), PREC(40), TPPRIM(40) As Variant
 Dim TPEXP(40), TPREC(40), STP(40), RESP(40, 40), REXP(40) As Variant
 
 Dim RPRIM(40), RREC(40), TREXP(40), TRPRIM(40) As Variant
 
 Dim TRREC(40), TSTP(40) As Variant
 Dim I As Integer
 Dim J As Integer
 Dim Ab As String
 Dim D As String
 

Private Sub Form_Load()

N = InputBox("INTRODUCETI MARIMEA GRUPULUI :")

For I = 1 To N
    For J = 1 To N
        MsgBox ("SUBIECTUL" & I)
        Ab = InputBox("ESTE ABSENT ? <A> PT> DA <cr> PT.NU ")
        If UCase(Ab) = "A" Then
            PREF(I, I) = "A"
            RESP(I, I) = "A"
            NA = NA + 1
            P = InputBox("PREFERA PE :")
            If P > N Then
                MsgBox ("GRESIT !")
            End If

            If P = I Then
                MsgBox ("ALEGERE IMPOSIBILA !")
            End If

            PREF(I, P) = "D"

            R = InputBox("RESPINGE PE : ")


            If R > N Then
                MsgBox ("GRESIT !")
            End If
            If R = I Then
                MsgBox ("ALEGERE IMPOSIBILA !")
            End If
 
            RESP(I, R) = "D"
        End If
    Next
 
    If PREF(I, I) = "A" Then
        NA = NA - 1
    End If
 
    For J = 1 To N
        PREF(I, J) = " "
        RESP(I, J) = " "
    Next
Next

For I = 1 To N
    For J = 1 To N
        If PREF(I, I) = "A" Then
            PEXP(I) = 11.11
            PREC(I) = 11.11
            REXP(I) = 11.11
            RREC(I) = 11.11
        End If

        If PREF(I, J) = "D" Then PEXP(I) = PEXP(I) + 1
        If PREF(I, J) = PREF(J, I) And PREF(I, J) = "D" Then PREC(I) = PREC(I) + 1
        If RESP(I, J) = "D" Then REXP(I) = REXP(I) + 1
        If RESP(I, J) = RESP(J, I) And RESP(I, J) = "D" Then RREC(I) = RREC(I) + 1
    Next
Next

For J = 1 To N
    For I = 1 To N
        If PREF(I, J) = "D" Then PPRIM(J) = PPRIM(J) + 1
        If RESP(I, J) = "D" Then RPRIM(J) = RPRIM(J) + 1
    Next
Next
For I = 1 To N
    If PEXP(I) = 11.11 Then
        SPEXP = SPEXP + PEXP(I)
        SPREC = SPREC + PREC(I)
        SREXP = SREXP + REXP(I)
        SRREC = SRREC + RREC(I)
    End If
Next
For J = 1 To N
    SPPRIM = SPPRIM + PPRIM(J)
    SRPRIM = SRPRIM + RPRIM(J)
Next J

MPEXP = MPEXP + SPEXP / (N - NA)
MPPRIM = SPPRIM / N
MPREC = SPREC / (N - NA)
MREXP = SREXP / (N - NA)
MRPRIM = SRPRIM / N
MRREC = SRREC / (N - NA)

If MRREC = 0 Then MRREC = 0.01

 
For I = 1 To N
720 If PEXP(I) = 11.11 Then GoTo 770
730 APEXP = APEXP + (PEXP(I) - MPEXP) ^ 2
740 APREC = APREC + (PREC(I) - MPREC) ^ 2
750 AREXP = AREXP + (REXP(I) - MREXP) ^ 2
760 ARREC = ARREC + (RREC(I) - MRREC) ^ 2
770 Next I
780 For J = 1 To N
790 APPRIM = APPRIM + (PPRIM(J) - MPPRIM) ^ 2
800 ARPRIM = ARPRIM + (RPRIM(J) - MRPRIM) ^ 2
810 Next J
820 APEXP = APEXP / (N - NA - 1)
830 APPRIM = APPRIM / (N - 1)
840 APREC = APREC / (N - NA - 1)
850 AREXP = AREXP / (N - NA - 1)
860 ARPRIM = ARPRIM / (N - 1)
870 ARREC = ARREC / (N - NA - 1)
880 APEXP = Sqr(APEXP)
890 APPRIM = Sqr(APPRIM)
900 APREC = Sqr(APREC)
910 AREXP = Sqr(AREXP)
911 If AREXP = 0 Then AREXP = 0.01
920 ARPRIM = Sqr(ARPRIM)
930 ARREC = Sqr(ARREC)
940 Print Chr(7)
950 For I = 1 To N
960 If PEXP(I) = 11.11 Then GoTo 970 Else GoTo 980
970 TPEXP(I) = 11.11: TPREC(I) = 11.11: TREXP(I) = 11.11: TRREC(I) = 11.11: GoTo 1020
980 TPEXP(I) = 50 + 10 * (PEXP(I) - MPEXP) / APEXP
990 TPREC(I) = 50 + 10 * (PREC(I) - MPREC) / APREC
1000 TREXP(I) = 50 + 10 * (MREXP - REXP(I)) / AREXP
1010 TRREC(I) = 50 + 10 * (MRREC - RREC(I)) / ARREC
1020 Next I
1030 For J = 1 To N
1040 TPPRIM(J) = 50 + 10 * (PPRIM(J) - MPPRIM) / APPRIM
1050 TRPRIM(J) = 50 + 10 * (MRPRIM - RPRIM(J)) / ARPRIM
1060 Next J
 

1570 For I = 1 To N
1580 STP(I) = (PPRIM(I) - RPRIM(I)) / (N - 1)
1590 SSTP = SSTP + STP(I)
1600 Next I
1610 MSTP = SSTP / N
1620 For I = 1 To N
1630 ASTP = ASTP + (STP(I) - MSTP) ^ 2
1640 Next I
1650 ASTP = ASTP / (N - 1)
1660 ASTP = Sqr(ASTP)
1670 For I = 1 To N
1680 TSTP(I) = 50 + 10 * (STP(I) - MSTP) / ASTP
1690 Next I
1700 Print "AM CALCULAT STATUTUL PREFERENTIAL"
1710 ISP = (SPREC - SRREC) / N
1720 ICO = N * (N - 1) / 2
1730 ICO = SPREC / ICO

End Sub

[soltuz liliana]

O intrebare!
La un buton de comanda pe un form creat am atasat un programel creat cu vba, ca cel atasat.
Acest program contine variabile introduse prin inputbox (N=numarul de subiecti).
Am atasat un alt buton care sa faca o actualizare a datelor introduse prin recordset dar nu gaseste valoare lui N introdusa anterior.
Deci la campurile calculate nu face nici o actualizare de date.
De exemplu:
pentru un camp

Cod: Selectaţi tot

For j= 1 to N
Abaterea=(A(j)*100)/100
next j

O sugestie, daca se poate???

[alcoool2]

Nu gaseste valoarea anterioara pentru ca nu l-ai pus sa o salveze. Daca intr-o variabil introduci o noua valoare vechia valoare se pierde. Dar pentru o corectura mai amanuntita si eventual o solutie de rog sa atasezi pe forum ce ia lucrat pana acuma.

[soltuz liliana]

O alta intrebare!
Am reusit sa adaug inregistrarile in tabel .AddNew , problema este acum ca la .Edit nu se intampla nimic

Cod: Selectaţi tot

sub edit_clik()
Dim rst as Recordset
set dbs=currentDb
set rst=dbs.OpenRecordset("Table")
For I =1 to N
	for J = 1 to c
		For Q = 1 to k
			rst.edit
			rst!Subiectul = I
			rst!A = A(j)
			rst!valoare=m(I,J,Q)
			rst.update
		next Q
	Next J
Next I
rst.Close
dbs.Close
end sub

ce gresesc?