Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: dane z textbox
anonim




Typ: Nie zarejestrowany
dane z textbox

problem niby prosty, ale trudny
w pliku mam trzy kolumny:
np:
TYP  x  y

S11  5  2
S12  5  3
S22  5  4
S31  6  5
S33  6  7
itd...

W etykiecie1 mam pewna dana, która ma byc porównywana z dana z kolumny x, oraz dana w etykiecie2, która ma byc porownywana z kolumną y i tak np. jesli etykieta1=4 a etykieta2=3,5 to do innej etykiety powinno zostac wczytane S22.

Jezeli ktos mnie zrozumiał, to prosze o pomoc )

20-06-2004 22:02
  
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

nie za bardzo wiem dla czego akurat powinno byc S22 ? (zaokraglenie w gore ?) bo S12 tak samo pasuje (zaokraglenie w dol )

21-06-2004 12:52
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
anonim




Typ: Nie zarejestrowany

S12 pasuje ale do kolumny x, ale dana z etykiety2=3,5  która ma byc jednoczenie porownana z kolumna y pasuje do S22, dane musza byc zaokraglane w gore i dopasowywane do danych z kolumn!!
jednym zdaniem: etykieta1 i etykieta2 musza byc porównywane jednoczesnie!!

21-06-2004 13:52
  
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

tu chyba nie do konca chodzi o zaokraglenie bo 4 nie idzie zaokraglic
czy program ma znajdowac najbardziej pasujace ?
jezeli bedzie :

S11  2  2
S12  2  3
S22  2  4
S31  6  5
S33  6  7

i e1=4 a e2=3,5 to co ma wybrac - S31 ?

dane w pliku sa narastajace ?
sa wszystkie liczby ( czy brakuje jakis ? - tak jak w moim przykladzie nie ma 3,4 i 5 w X)
czy jednoczesnie powtarzaja sie wartosci X i Y np

S22  2  4  - to
S31  6  5
S33  2  4  - to


podales chyba za malo danych do rozwiazania problemu

21-06-2004 14:29
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
anonim




Typ: Nie zarejestrowany

tak w Twoim przypadku bedzie to S31;

nie ma wszytkich liczb, moga miec rozna wartosc oraz mogą sie powtarzac, ale jezeli sie powtaraja to ma byc wybrana pierwsza wartosc TYP;

program ma znajdowac najbardziej pasujace; ale wyzszy priorytet ma wartosc X,to jest najwazniejsze, najpierw nalezy X uwzglednic, a nastepnie dopasowac dotego kolumne Y; dane w X i Y nie sa rosnace;

21-06-2004 15:17
  
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

Jeszcze ostatnie pytania - liczby w pliku tekstowym rozdziela spacja ?
liczby sa calkowite , wystepuja liczby ujemne ?

21-06-2004 19:08
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
anonim




Typ: Nie zarejestrowany

dane są rozdzielane spacjami, nie są ujemne, ale są  w postaci (0,00)

21-06-2004 20:18
  
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

Programik juz zrobiony, tylko wyskoczyl pewien problem... co zrobic gdy mamy :

S11  2  2
S12  2  3
S22  2  4
S31  6  5
S33  6  7

i E1=2 E2=4,5 ??? ma wybrac S31 czy jednak mniejsza wartosc S22 ?
moglbys tez sie zarejestrowac na forum lub podac e-mail gdzie wyslac programik...

22-06-2004 10:35
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
siQor




Typ: neutral
Postów: 2
Zarejestrowany: Jun 2004

no program powinien wybrac S31 bo E1 musi byc mniejsze od kolumny X, nie moze byc rowne; jezeli np. E1=1,99999 a E2=4,5 to powinien wybrac S22;
pozdrawiam

22-06-2004 11:46
Pokaż profil siQor  Wyślij email do siQor   
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

'nie wiem jak wiele masz danych w pliku , ale ja zakladalem ze max 100 lini

Dim TYP(100) As String  'typ
Dim X(100) As Single    'wartosc X
Dim Y(100) As Single    'wartosc Y
Dim Wpisow As Integer  'ile odczytal wpisow

Private Sub Form_Load()

Dim Dane As String
Dim FreeCan As Integer
Dim Spacja1 As Integer
Dim Spacja2 As Integer

FreeCan = FreeFile
Wpisow = 0

Open App.Path + "\dane.txt" For Input As #FreeCan
   
    Line Input #FreeCan, Dane  'pomijam naglowek pliku - TYP X Y (jak go nie ma to usunac ta linie)
   
    While EOF(FreeCan) <> -1
       
        Line Input #FreeCan, Dane
   
        'usuwamy spacje poczatkowe i koncowe
        Dane = Trim(Dane)
   
        'czy cos odczytalismy ?
        If Dane <> "" Then
   
            'zamieniamy przecinki na kropki
            Dane = Kropka(Dane)
         
            'zwiekszamy licznik wpisow
            Wpisow = Wpisow + 1
       
            'szukamy pierwszej spacji i to co przed nia to TYP
            Spacja1 = InStr(1, Dane, " " ) + 1
   
            'wyciagamy TYP
            TYP(Wpisow) = Left(Dane, Spacja1 - 2)
       
            'usuwamy ze zmiennej Dane wartosc TYP i spacje poprzedzajace X
            Dane = Trim(Right(Dane, Len(Dane) - Len(TYP(Wpisow))))
   
            'szukamy kolejnej spacji (rozdzielajacej X od Y)
            Spacja2 = InStr(1, Dane, " " )
                           
            'wyciagamy X
            X(Wpisow) = Val(Left(Dane, Spacja2 - 1))
       
            'wyciagamy Y
            Y(Wpisow) = Val(Right(Dane, (Len(Dane) - (Spacja2 - 1))))
   
        End If
       
    Wend
   
Close FreeCan

'znajdz nam pasujacy do E1=1.9999 i E2=4.5
MsgBox Szukaj(1.99999, 4.5)

End

End Sub



'==========================================
Function Kropka(Liczba As String) As String
'zamieniamy przecinki na kropki (bo funkcja VAL bedzie zle liczyla)

Dim b As Integer

    b = 1
    While b > 0
        b = InStr(1, Liczba, "," )
        If b > 0 Then
            Mid(Liczba, b, 1) = "."
        End If
    Wend

Kropka = Liczba

End Function



'==========================================
Function Szukaj(E1 As Single, E2 As Single) As String

'szukanie najbardziej pasujacego
Dim a As Integer
Dim Dx As Single
Dim Dy As Single
Dim minX As Single
Dim minY As Single
Dim Wybrany As Integer

'zakladam ze X i Y nie przyjmuja wartosci wiekszych niz 10000
minX = 10000
minY = 10000

'przeszukaj wszystkie wpisy
    For a = 1 To Wpisow
       
        Dx = X(a) - E1
        Dy = Y(a) - E2
       
        'jezeli znajdziesz pasujacy to zakoncz
        If Dx = 0 And Dy = 0 Then
            Wybrany = a
            Exit For
        End If
       
        'sprawdz warunki
        If Dx >= 0 And Dx <= minX Then
       
            If Dx < minX Then
                minX = Dx
                minY = Dy
                Wybrany = a
            ElseIf Abs(Dy) < Abs(minY) Then
                minY = Dy
                Wybrany = a
            End If
           
        End If
               
    Next a

    'znalazles cos?
    If Wybrany > 0 Then
        Szukaj = TYP(Wybrany)
    Else
        Szukaj = "Brak danych"
    End If

End Function


Jakby cos nie tak to podeslij mi plik z danymi i kilka przykladow np.
E1=2 E2=1.45 wynik S23
E1=1.5 E2=2 wynik S31 itd.

22-06-2004 14:15
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
deywid



Typ: neutral
Postów: 66
Zarejestrowany: Jan 2004

jak nie wiesz ile masz lini w pliku (tzn. danych : Typ, x,y) to mozesz zrobic cos takiego...
przyjalem ze miedzy danymi sa 2 spacje
===================
  Dim strFileName1j As String
  Dim strText1j As String
  Dim strFilter1j As String
  Dim strBuffer1j As String
  Dim FileHandle1j%

       
        a = "-1"
        strFileName1j = App.Path & "" & "dane" & ".txt"
        FileHandle1j% = FreeFile
        Open strFileName1j For Input As #FileHandle1j%
        MousePointer = vbHourglass
        Do While Not EOF(FileHandle1j%)
       
        Line Input #FileHandle1j%, strBuffer1j
        gdzie_pierwsza = InStr(1, strBuffer1j, "  "
        a = a + 1
        ReDim Preserve typ(a)
        ReDim Preserve X(a)
        ReDim Preserve y(a)
        dl = Len(strBuffer1j)
        typ(a) = Left(strBuffer1j, gdzie_pierwsza - 1)
        gdzie_druga = InStr(gdzie_pierwsza + 1, strBuffer1j, "  "
        X(a) = Val(Mid(strBuffer1j, gdzie_pierwsza, gdzie_druga - gdzie_pierwsza))
        y(a) = Val(Right(strBuffer1j, dl - gdzie_druga))

        Loop
        MousePointer = vbDefault
        Close #FileHandle1j%
==========
w "a" bedziesz mial zapisaną ostatnia zajeta w tablicy
np.a=100 tzn ze tablica jest od 0 do 99
Byc moze ci sie to przyda nie wiem....
pozdrawiam

[Post edytowany dnia 22-06-2004 15:01 przez deywid]

22-06-2004 15:00
Pokaż profil deywid  Wyślij email do deywid        5625009
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

mozna te linie policzyc jeszcze inaczej ale zaraz przygotuje plik z 5000 lini i sprawdze ktory sposob bedzie szybszy... jak nowy to dam przyklad , a jak nie to nie chce sie zblaznic... na razie mam go w glowie...

22-06-2004 16:33
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003

no jest szybszy ... przy 525 000 liniach jest szybszy o prawie 1 sek. bu ha ha
nie bede pisal co to byl za pomysl...

22-06-2004 17:25
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
siQor




Typ: neutral
Postów: 2
Zarejestrowany: Jun 2004

dziekuje Wam bardzo , zaraz sprawdzam , ale napewno wszytko jest ok!!! jescze raz dzieki!!!

22-06-2004 21:21
Pokaż profil siQor  Wyślij email do siQor   
karolinavb




Typ: neutral
Postów: 468
Zarejestrowany: Jan 2003

A może ADODB ? - przykładowy kof formy

Option Explicit
'''' Referencje do Microsoft ActiveX Data Objects 2.X Library
Dim strTXTDirectory As String
Dim strSQLString As String
Dim bOtwartyRS As Boolean
Dim bJestWynik As Boolean
Dim strTXTFilename As String
Dim oConn As ADODB.Connection
Dim WithEvents oRS As ADODB.Recordset

Private Sub cmdSzukaj_Click()
Call SzukajMin
End Sub

Public Sub TextFile2ADO()
'''' plik tekstowy do ADODB.Recordset
On Error GoTo lerror
strTXTFilename = "pasuj2.txt"
strTXTDirectory = App.Path & "\"

Call TworzSchemaIni(strTXTFilename, strTXTDirectory)

Set oConn = New ADODB.Connection
Set oRS = New ADODB.Recordset
'''' łańcuch połączenia
oConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
  "Data Source=" & strTXTDirectory & ";" & _
  "Extended Properties=""text;HDR=no;"""

oConn.Open
If oConn.State = adStateOpen Then
    strSQLString = "SELECT TYP,x,y,CDbl('0') " _
        & "AS roznica FROM " & strTXTFilename
    With oRS
        .ActiveConnection = oConn
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .Open strSQLString, , , , adCmdText
       
        .MoveFirst
        bOtwartyRS = True
        ''''' tylko dla sprawdzenia
        Call TylkoDlaSprawdzenia
    End With
End If
Exit Sub
lerror:
    bOtwartyRS = False
    MsgBox (Err.Description & vbCrLf & Err.Number & vbCrLf & "Sub TextFile2ADO" )
End Sub

Private Sub TworzSchemaIni(ByVal strTXTFilename As String, ByVal strDir As String)
[green'''' tworzenie pliku schema.ini dla opisu pliku danych
Dim nPlik As Integer
nPlik = FreeFile
Open strDir & "\schema.ini" For Output As #nPlik
Print #nPlik, "[" & strTXTFilename & "]"
Print #nPlik, "ColNameHeader = False"
'''' jesli kolumny byłyby oddzielone tabulatorem wówczas poniższa linijka
'''' Print #nPlik, "Format = TabDelimited"
'''' jeśli kolumny są odzielone spacją w środku nawiasu jest spacja

Print #nPlik, "Format = Delimited( )"
Print #nPlik, "col1=TYP Text"
Print #nPlik, "col2=x Double"
Print #nPlik, "col3=y Double"
Print #nPlik, "DecimalSymbol=,"
Close #nPlik

End Sub

Private Sub Form_Load()
Call TextFile2ADO
End Sub

Private Sub Form_Unload(Cancel As Integer)
With oRS
    If .State = adStateOpen Then .Close
End With
Set oRS = Nothing
With oConn
    If .State = adStateOpen Then .Close
End With
Set oConn = Nothing
End Sub

Private Sub SzukajMin()
On Error GoTo lerror
bJestWynik = False
'''' TXTx - TextBox - kolumny X
'''' TXTy - TextBox  - kolumny Y


If Trim(TXTx) <> "" And Trim(Txty) <> "" Then
    If oConn.State = adStateOpen Then
        '''' zmieniając poniższy łańcuch można uzyskać różne warunki
        strSQLString = "SELECT TYP,x,y,ABS(y-" _
            & Trim(Txty) & " AS roznica FROM " _
            & strTXTFilename & " WHERE (x>" _
            & Trim(TXTx) & " ORDER BY 4 "
        With oRS
            bOtwartyRS = False
            .Close
            .Open strSQLString, , , , adCmdText
            If Not .BOF And Not .EOF Then
                '''' jeśli jest jakiś wynik znajduje się na 1-szym rekordzie
                .MoveFirst
                '''' Label wyniku
                lblWynik.Caption = CStr(.Fields("TYP".Value)
                bJestWynik = True
            Else
                bJestWynik = False
            End If
            bOtwartyRS = True
            Call TylkoDlaSprawdzenia
            If bJestWynik Then
                MsgBox (lblWynik.Caption)
            Else
                MsgBox ("Brak wyniku" )
            End If
        End With
    End If
Else
    MsgBox ("Pola danych nie wypełnione" )
End If
Exit Sub
lerror:
    bOtwartyRS = False
    MsgBox (Err.Description & vbCrLf & Err.Number & vbCrLf & "Sub TextFile2ADO" )
   
End Sub
'****************poniższe tylko dla sprawdzenia w tej formie*****************
Private Sub TylkoDlaSprawdzenia()
''' AdodcTextFile - ADO Data Control tylko przykładowo dla sprawdzenia, pozostałe kontrolki też
Set AdodcTextFile.Recordset = oRS
With oRS
    LblTYP.DataField = .Fields(0).Name
    LblX.DataField = .Fields(1).Name
    LblY.DataField = .Fields(2).Name
    lblRoznica.DataField = .Fields(3).Name
   
    Set LblTYP.DataSource = AdodcTextFile
    Set LblX.DataSource = AdodcTextFile
    Set LblY.DataSource = AdodcTextFile
    Set lblRoznica.DataSource = AdodcTextFile
End With
End Sub

Private Sub txty_KeyPress(KeyAscii As Integer)
' TextBox dla warunku Y
Call TylkoCyfryAndKropka(Txty.Text, KeyAscii)
End Sub

Private Sub txtx_KeyPress(KeyAscii As Integer)
'''' TextBox dla warunku X
Call TylkoCyfryAndKropka(TXTx.Text, KeyAscii)
End Sub

Private Sub TylkoCyfryAndKropka(ByVal sText As String, ByRef KeyAscii As Integer)
    Select Case KeyAscii
        Case 46
            If sText <> "" And IsNumeric(sText) = False Then
                KeyAscii = 0
            End If
        Case 33 To 47, 58 To 126, 32, 140 To 243
            KeyAscii = 0
    End Select
End Sub




Treść wygenerowanego pliku schema.ini

[pasuj2.txt]
ColNameHeader = False
Format = Delimited( )
col1=TYP Text
col2=x Double
col3=y Double
DecimalSymbol=,



_____________________________________________
Karolina

23-06-2004 01:50
Pokaż profil karolinavb  Wyślij email do karolinavb   
Knight Lore''FC




Typ: neutral
Postów: 240
Zarejestrowany: Jan 2003


jak nie wiesz ile masz lini w pliku (tzn. danych : Typ, x,y) to mozesz zrobic cos takiego...


Znalazlem chyba najszybszy sposob jak sprawdzic ile jest lini w pliku i zaladowac odrazu te linie do tablicy


'-------------------------------------
Private Sub Command1_Click()
Dim buff As String

buff = String(FileLen(App.Path + "\test.txt" ), 32)

Open App.Path + "\test.txt" For Binary As #1
    Get #1, , buff
Close #1

tablica = Split(buff, Chr(13)+ Chr(10)) ' <= tu !!!!

MsgBox UBound(tablica)
MsgBox tablica(0) ' pierwsza linia

End Sub

24-06-2004 14:52
Pokaż profil Knight Lore  Wyślij email do Knight Lore        1065423
Wszystkich odpowiedzi: 15 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1