Lemur zaprasza
Strona: [ > ] 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 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 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 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 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 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 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 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 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 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 karolinavb Typ: neutral Postów: 467 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 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 1065423 Wszystkich odpowiedzi: 15 :: Maxymalnie na stronę: 20 Strona: [ > ] z 1 |