Avaleht
uus teema   vasta Tarkvara »  Programmeerimine »  vb(a) koodis viga. märgi kõik teemad loetuks
märgi mitteloetuks
vaata eelmist teemat :: vaata järgmist teemat
Hinnavaatlus :: Foorum :: Uudised :: Ärifoorumid :: HV F1 ennustusvõistlus :: Pangalink :: Telekavad :: HV toote otsing
autor
sõnum Saada viide sõbrale.  :: Teata moderaatorile teata moderaatorile
otsing:  
lall
HV vaatleja

liitunud: 16.08.2006
sõnum 17.11.2008 09:44:01 vb(a) koodis viga. vasta tsitaadiga
Tere.

Probleem järgmine.
See vba võtab sheet1'lt tulbast C ühe koodi, ning otsib sellele vastet sheet2'lt. Ning kui leiab, siis teeb omad asjad ära (ehk siis võtab sheet1'lt otsitavalt koodilt samalt realt vastava väärtuse, ning asendab selle sheet2'l oleva koodi väärtusega[pole oluline]).

Kui tulbast C võetud koodile vastust sheet2'lt ei leita, teeb sheet2'le uue rea, kus kõik peale 2 tulba on fixeeritud väärtused. Teised kaks - üks on kood millele vastet ei leita, ning teine sellele vastav väärtus.(pole ka oluline)

AGA, see peaks toimina hoopis nii, et:
võtma sheet1'lt tulbast C koodi ja otsima sellele vastet sheet2'lt. Kui ei leia [mitte ei rutta uut rida sheet2'le tegema, vaid:] siis võtab esimese alternatiivkoodi tulbast E. [Põhikood on tulbas C ja alternatiivid tulpades E:M]. Kui tulbast E ka ei leia midagi, siis otsima edasi kuni vastava rea viimase alternatiivini.
Kui ikka veel pole leitud (siis põhikoodile ega ühelegi sellele vastavale alternatiivile) vastust sheet2'lt - alles SIIS tegema uue rea sheet2 lõppu.

Kõik see on siin koodis olemas, kuid ainuke viga ongi see, et see vba ei loopi läbi vastava rea, vaid kontrollib vaid esimest koodi.

Private Sub convert_new_pdt()

Dim a, i As Long, x As Long, b()
Dim ColA_H, myKeys, myItems, myCount As Long

'fikseeritud tulpade väärtused
ColA_H = Array("F", "20081111", "1111", "260001", "999999", "1", "2", "0")

With Sheets("sheet1")
    a = .Range("a6", .Range("a" & Rows.Count).End(xlUp)).Resize(, 24).Value
End With

With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
'vahemik, kus koodid asuvad
        For ii = 3 To 13
'KAS SIIN ON VIGA??
            If (ii <> 4) * (a(i, ii) <> "") Then .Item(a(i, ii)) = a(i, 24)
        Next
    Next
    With Sheets("sheet2")
'mittefixeeritud tulbad(kood[i], ning sellele vastav väärtus[k])
        x = .Range("i" & Rows.Count).End(xlUp).Row
        a = .Range("i1:i" & x).Value
        b = .Range("k1:k" & x).Value
    End With
    For i = 1 To UBound(a, 1)
        If .exists(a(i, 1)) Then
            b(i, 1) = .Item(a(i, 1))
            .Remove (a(i, 1))
        End If
    Next
    Sheets("sheet2").Range("k1").Resize(UBound(a, 1)).Value = b
    If .Count = 0 Then Exit Sub
    myKeys = .keys: myItems = .items: myCount = .Count: x = UBound(a, 1)
End With


With Sheets("sheet2").Range("a" & UBound(a, 1) + 1).Resize(myCount)
    .Resize(, 8).Value = ColA_H
    .Offset(, 8).Value = Application.Transpose(myKeys)
    .Offset(, 9).Value = 0
    .Offset(, 10).Value = Application.Transpose(myItems)
    .Offset(, 11).Value = 0
End With
End Sub


On siin mõnda tegijat, kes viitsiks/suudaks selle ära parandada?
Kui on küsimusi - vastan hea meelega!
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
infidel
HV kasutaja
infidel

liitunud: 31.01.2004
sõnum 17.11.2008 10:40:38 vasta tsitaadiga
Ütlen ausalt, minu jaoks jäi see kood küll natuke segaseks.
Pakuks alternatiiviks sellise variandi:
Function vaste_lehel_2(v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
With Sheets(2)
Do
i = i + 1
lahter = Cells(i, 1).Value
If lahter = v22rtus Then
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End With
End Function


Sub mingi_asi()
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Cells(ReaNumber, 3).Value
If vaste_lehel_2(koodilahter) Then
'Teeb oma vajalikud asjad ära
Else
For i = 5 To 13
If vaste_lehel_2(Cells(ReaNumber, i)) Then
'Teeb taas vajalikud asjad
Exit For
Else
if i = 13 then 'viimane lahter
'Teeb Sheet2 peale uue rea
end if
End If
Next i
End If
Loop Until koodilahter = ""
End Sub

Kuna ma hästi aru ei saanud (ja süveneda ei viitsinud), mis lahtri sisu kuhu täpselt tõstma peab, siis märkisin nende funktsioonide kohad lihtsalt kommentaariga. Minu koodis on ka eelduseks see, et vastet otsitakse Sheet2 esimesest veerust.
Kommentaarid: 36 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 35
tagasi üles
vaata kasutaja infot saada privaatsõnum
lall
HV vaatleja

liitunud: 16.08.2006
sõnum 17.11.2008 11:14:06 vasta tsitaadiga
infidel kirjutas:
Ütlen ausalt, minu jaoks jäi see kood küll natuke segaseks.
Pakuks alternatiiviks sellise variandi:
Function vaste_lehel_2(v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
With Sheets(2)
Do
i = i + 1
lahter = Cells(i, 1).Value
If lahter = v22rtus Then
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End With
End Function


Sub mingi_asi()
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Cells(ReaNumber, 3).Value
If vaste_lehel_2(koodilahter) Then
'Teeb oma vajalikud asjad ära
Else
For i = 5 To 13
If vaste_lehel_2(Cells(ReaNumber, i)) Then
'Teeb taas vajalikud asjad
Exit For
Else
'Teeb Sheet2 peale uue rea
End If
Next i
End If
Loop Until koodilahter = ""
End Sub

Kuna ma hästi aru ei saanud (ja süveneda ei viitsinud), mis lahtri sisu kuhu täpselt tõstma peab, siis märkisin nende funktsioonide kohad lihtsalt kommentaariga. Minu koodis on ka eelduseks see, et vastet otsitakse Sheet2 esimesest veerust.


Ma siis seletan täpselt ära kuidas lehed välja näevad ning mis täpselt toimuma peab.
-----------------------------------------------------------------------------------------------------------------------------------

Sheet1 sisaldab mul tohutut hinnikut andmeid (kuni paarsada tuhat rida, xl 2007. seega vajan kiireid koode, mis kasutaks võimalikult vähe loope ja selectimist).

Sheet1 tulpades c, e:m on koodid, kus tulp C sisaldab põhikoodi ning tulbad e:m alternatiivkoode.[kasutada vba's]
Sheet1 tulp W sisaldab väärtusi(paranduste lahter)[pole vba'le vajalik]
Sheet1 tulp X sisaldab formaaditud väärtust, mis tuleneb tulbast W. [seda tulpa tuleb kasutada vba's]
---
Sheet2 tulp i sisaldab koodi - sama kood mis on sheet1'l ÜHES nendes tulpadest: c, e:m.
Sheet2 tulp k sisaldab koodile vastavat väärtust - ning see väärtus tuleb asendada sellega, mis on sheet1'l tulbas X [kood seob neid ridu/väärtusi]

Näide:
sheet1:
Column C Column X
11223344 1312

Sheet2:
Column C Column X
11223344 999

Ning peale vba'd peaks 999 olema asendatud väärtusega 1312.

Nüüd läheb aga asi keerulisemaks:

Kui kood mis on võetud sheet1'lt tulbast C ei leia vastust Sheet2'lt tulbast i, siis peab vba võtma mitte uuelt realt uue koodi, vaid esimese alternatiivkoodi samalt realt(alternatiivid on siis tuplades e:m).
Ning kui on olemas vastus sheet2'l siis asendama selle väärtuse. Lihtne.
Kui aga ikka veel, olles läbi otsitud nii põhikood kui ka kõik alternatiivid pole vastust - siis tuleb teha sheet2'le uus rida kus on kõik peale nende 2 tulba (i ja k) fikseeritud. Tulp i peab sisaldama selle rea põhikoodi kust millele vastust ei leitud ning tulp k peab sisaldama sellele koodile vastavat väärtust.

Seega - sheet2 sisaldab 2 sarnasust sheet1'ga - tulpa i ja k. tulp i sisaldab koodi [kas siis põhi või üht alternatiivi] ning tulp K sisaldab sellele vastavat väärtust.

Ja siit probleem:

Praegu minu kood teeb 99% nii nagu vaja - ainult - see ei arvesta alternatiivkoodidega. Ehk - kui tulbast C võetud kood leiab vastuse sheet2'lt on kõik korras(väärtus asendatakse).
Kui aga tulba C koodile vastust ei leita, siis ta mitte ei otsi edasi läbi alternatiivide vaid teeb juba uue rea. Ning see ei sobi mitte kuidagi.
Selleasemel teeb ta mitu uut rida sheet2'le - näiteks kui põhikoodile vastust ei leita sheet2'lt, aga ühele alternatiivile oleks leidnud kui oleks sellega arvestatud, siis on olemas nii alternatiivkood ja selle väärtus sheet2l, kui ka tehtud põhikoodiga rida sheet2'l. [Tekib dublikaat]
-----

Kogu see pikk jutt on kokkutõmmatuna tegelikult päris lihtne, kuid minu pea enam sellele peale ei hakka.
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
infidel
HV kasutaja
infidel

liitunud: 31.01.2004
sõnum 17.11.2008 11:54:31 vasta tsitaadiga
Function vaste_lehel_2(kood, v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
With Sheets(2)
Do
i = i + 1
lahter = Cells(i, 9).Value
If lahter = kood Then
Cells(i, 11).Value = v22rtus
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End With
End Function


Sub mingi_asi()
With Sheets(1)
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Cells(ReaNumber, 3).Value
v22rtuse_lahter = Cells(ReaNumber, 24).Value
If Not vaste_lehel_2(koodilahter, v22rtuse_lahter) Then 'Teeb oma vajalikud asjad funktsiooniga ära
For i = 5 To 13
If vaste_lehel_2(Cells(ReaNumber, i).Value, v22rtuse_lahter) Then 'Teeb taas vajalikud asjad funktsiooni käigus
Exit For
Else
If i = 13 Then 'viimane lahter
lisa_kirje_teisele_lehele Cells(ReaNumber, 3).Value, v22rtuse_lahter
'Teeb Sheet2 peale uue rea
End If
End If
Next i
End If
Loop Until koodilahter = ""
End With
End Sub


Sub lisa_kirje_teisele_lehele(kood, v22rtus)
With Sheets(2)
Dim i As Integer
Do
i = i + 1
Loop Until Cells(i, 1).Value = ""
Cells(i, 1).Value = "F" 'ColA_H = Array("F", "20081111", "1111", "260001", "999999", "1", "2", "0")
Cells(i, 2).Value = "20081111"
Cells(i, 3).Value = "1111"
Cells(i, 4).Value = "260001"
Cells(i, 5).Value = "999999"
Cells(i, 6).Value = "1"
Cells(i, 7).Value = "2"
Cells(i, 8).Value = "0"
Cells(i, 9).Value = kood
Cells(i, 11).Value = v22rtus
End With
End Sub


Äkki niimoodi?
Kommentaarid: 36 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 35
tagasi üles
vaata kasutaja infot saada privaatsõnum
lall
HV vaatleja

liitunud: 16.08.2006
sõnum 17.11.2008 12:32:52 vasta tsitaadiga
infidel kirjutas:
Function vaste_lehel_2(kood, v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
With Sheets(2)
Do
i = i + 1
lahter = Cells(i, 9).Value
If lahter = kood Then
Cells(i, 11).Value = v22rtus
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End With
End Function


Sub mingi_asi()
With Sheets(1)
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Cells(ReaNumber, 3).Value
v22rtuse_lahter = Cells(ReaNumber, 24).Value
If Not vaste_lehel_2(koodilahter, v22rtuse_lahter) Then 'Teeb oma vajalikud asjad funktsiooniga ära
For i = 5 To 13
If vaste_lehel_2(Cells(ReaNumber, i).Value, v22rtuse_lahter) Then 'Teeb taas vajalikud asjad funktsiooni käigus
Exit For
Else
If i = 13 Then 'viimane lahter
lisa_kirje_teisele_lehele Cells(ReaNumber, 3).Value, v22rtuse_lahter
'Teeb Sheet2 peale uue rea
End If
End If
Next i
End If
Loop Until koodilahter = ""
End With
End Sub


Sub lisa_kirje_teisele_lehele(kood, v22rtus)
With Sheets(2)
Dim i As Integer
Do
i = i + 1
Loop Until Cells(i, 1).Value = ""
Cells(i, 1).Value = "F" 'ColA_H = Array("F", "20081111", "1111", "260001", "999999", "1", "2", "0")
Cells(i, 2).Value = "20081111"
Cells(i, 3).Value = "1111"
Cells(i, 4).Value = "260001"
Cells(i, 5).Value = "999999"
Cells(i, 6).Value = "1"
Cells(i, 7).Value = "2"
Cells(i, 8).Value = "0"
Cells(i, 9).Value = kood
Cells(i, 11).Value = v22rtus
End With
End Sub


Äkki niimoodi?

Oeh, ei funka mitte.
Praegu pea liiga paks et edasi mõelda..kontrollin pärast ja vaatan kas saan pihta mis kus valesti.
Aga tänud, et viitsisid vaadata - tavaliselt ehmatatakse pika jutu ja seletamise peale täitsa ära.
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
infidel
HV kasutaja
infidel

liitunud: 31.01.2004
sõnum 17.11.2008 12:53:31 vasta tsitaadiga
Function vaste_lehel_2(kood, v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
Do
i = i + 1
lahter = Worksheets(2).Cells(i, 9).Value
If lahter = kood And lahter <> "" Then
Worksheets(2).Cells(i, 11).Value = v22rtus
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End Function


Sub mingi_asi()
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Worksheets(1).Cells(ReaNumber, 3).Value
v22rtuse_lahter = Worksheets(1).Cells(ReaNumber, 24).Value
If koodilahter <> "" Then
If Not vaste_lehel_2(koodilahter, v22rtuse_lahter) Then 'Teeb oma vajalikud asjad funktsiooniga ära
For i = 5 To 13
If vaste_lehel_2(Worksheets(1).Cells(ReaNumber, i).Value, v22rtuse_lahter) Then 'Teeb taas vajalikud asjad funktsiooni käigus
Exit For
Else
If i = 13 Then 'viimane lahter
lisa_kirje_teisele_lehele Worksheets(1).Cells(ReaNumber, 3).Value, v22rtuse_lahter
'Teeb Sheet2 peale uue rea
End If
End If
Next i
End If
End If
Loop Until koodilahter = ""
Exit Sub
End Sub


Sub lisa_kirje_teisele_lehele(kood, v22rtus)
Dim i As Integer
Do
i = i + 1
Loop Until Worksheets(2).Cells(i, 1).Value = ""
Worksheets(2).Cells(i, 1).Value = "F" 'ColA_H = Array("F", "20081111", "1111", "260001", "999999", "1", "2", "0")
Worksheets(2).Cells(i, 2).Value = "20081111"
Worksheets(2).Cells(i, 3).Value = "1111"
Worksheets(2).Cells(i, 4).Value = "260001"
Worksheets(2).Cells(i, 5).Value = "999999"
Worksheets(2).Cells(i, 6).Value = "1"
Worksheets(2).Cells(i, 7).Value = "2"
Worksheets(2).Cells(i, 8).Value = "0"
Worksheets(2).Cells(i, 9).Value = kood
Worksheets(2).Cells(i, 11).Value = v22rtus
End Sub

Tuleb välja, et koodi tuleb ikka katsetada ka natuke. Tekitasin mõned andmed ja leidsin päris mitu kahtlast kohta. Aga nüüdne variant peaks toimima.
Kommentaarid: 36 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 35
tagasi üles
vaata kasutaja infot saada privaatsõnum
lall
HV vaatleja

liitunud: 16.08.2006
sõnum 17.11.2008 13:48:11 vasta tsitaadiga
infidel kirjutas:
Function vaste_lehel_2(kood, v22rtus) As Boolean
Dim i As Integer
i = 0
vaste_lehel_2 = False
Do
i = i + 1
lahter = Worksheets(2).Cells(i, 9).Value
If lahter = kood And lahter <> "" Then
Worksheets(2).Cells(i, 11).Value = v22rtus
vaste_lehel_2 = True
Exit Function
End If
Loop Until lahter = ""
End Function


Sub mingi_asi()
Dim ReaNumber As Integer
ReaNumber = 0
Do
ReaNumber = ReaNumber + 1
koodilahter = Worksheets(1).Cells(ReaNumber, 3).Value
v22rtuse_lahter = Worksheets(1).Cells(ReaNumber, 24).Value
If koodilahter <> "" Then
If Not vaste_lehel_2(koodilahter, v22rtuse_lahter) Then 'Teeb oma vajalikud asjad funktsiooniga ära
For i = 5 To 13
If vaste_lehel_2(Worksheets(1).Cells(ReaNumber, i).Value, v22rtuse_lahter) Then 'Teeb taas vajalikud asjad funktsiooni käigus
Exit For
Else
If i = 13 Then 'viimane lahter
lisa_kirje_teisele_lehele Worksheets(1).Cells(ReaNumber, 3).Value, v22rtuse_lahter
'Teeb Sheet2 peale uue rea
End If
End If
Next i
End If
End If
Loop Until koodilahter = ""
Exit Sub
End Sub


Sub lisa_kirje_teisele_lehele(kood, v22rtus)
Dim i As Integer
Do
i = i + 1
Loop Until Worksheets(2).Cells(i, 1).Value = ""
Worksheets(2).Cells(i, 1).Value = "F" 'ColA_H = Array("F", "20081111", "1111", "260001", "999999", "1", "2", "0")
Worksheets(2).Cells(i, 2).Value = "20081111"
Worksheets(2).Cells(i, 3).Value = "1111"
Worksheets(2).Cells(i, 4).Value = "260001"
Worksheets(2).Cells(i, 5).Value = "999999"
Worksheets(2).Cells(i, 6).Value = "1"
Worksheets(2).Cells(i, 7).Value = "2"
Worksheets(2).Cells(i, 8).Value = "0"
Worksheets(2).Cells(i, 9).Value = kood
Worksheets(2).Cells(i, 11).Value = v22rtus
End Sub

Tuleb välja, et koodi tuleb ikka katsetada ka natuke. Tekitasin mõned andmed ja leidsin päris mitu kahtlast kohta. Aga nüüdne variant peaks toimima.


Ikka ei,kuid
katsetan edasi ja annan teada.
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
näita postitusi alates eelmisest:   
uus teema   vasta Tarkvara »  Programmeerimine »  vb(a) koodis viga.
[vaata eelmist teemat] [vaata järgmist teemat]
 lisa lemmikuks
näita foorumit:  
 ignoreeri teemat 
sa ei või postitada uusi teemasid siia foorumisse
sa ei või vastata selle foorumi teemadele
sa ei või muuta oma postitusi selles foorumis
sa ei või kustutada oma postitusi selles foorumis
sa ei või vastata küsitlustele selles foorumis
sa ei saa lisada manuseid selles foorumis
sa võid manuseid alla laadida selles foorumis



Hinnavaatlus ei vastuta foorumis tehtud postituste eest.