Lemur zaprasza
Strona: [ > ] z 1 Autor Temat: szukanie + wyswietlanie + kasowanie anonim Typ: Nie zarejestrowany szukanie + wyswietlanie + kasowanie witam wszystkich, mam nastepujace problemy z vba 1. potrzebuje napisac procedure ktora najpierw wyszuka pewne dane zawarte w arkuszu 1 ( imiona,nazwiska,adresy,itp) z userform a potem przeniesie wszystkie znalezione dane do arkusza 2 ( chodzi mi o to zeby bylo tak, ze jak wpisze imie jan i miejscowosc warszawa to zeby w arkuszu 2 umiescil wszystkich janow z wa-wy z reszta danych opisujacych poszczegolne osoby,i ponumerowal ich) 2. druga procedura powinna tak jak w pkt 1 wyszukac, a potem skasowac poszczegolne dane z arkusza 1 z gory dziekuje za pomoc 12-02-2005 20:56 anonim Typ: Nie zarejestrowany aha, zalezy mi na szybkiej pomocy 12-02-2005 21:24 losmac "profesorek" Typ: neutral Postów: 758 Zarejestrowany: May 2003 Trudno jest Ci pomóc, bo nie wiem, jak są zorganizowane dane w Twoim arkuszu. Zakładając, że: kol. A -> Imię, kol. B -> Nazwisko, kol. C -> Adres. Masz 3 pola, po których możesz wyszukiwać pasujące dane. Zatem, w UserForm musisz mieć również 3 pola, w których będziesz mógł wpisać to, co chcesz wyszukać. Dla poszczególnych pól przypisz właściwość Tag: TxtFnd1 = 1 'imie TxtFnd2 = 2 'nazwisko TxtFnd3 = 3 'adres Option Explicit Private Sub CmdCancel_Click() Unload Me End Sub Private Sub CmdOK_Click() Dim retVal As Long, i As Long Dim sFnd As String, rng As Range For i = 1 To 3 If Me.Controls("TxtFnd" & i).Value <> "" Then retVal = (CLng(Me.Controls("TxtFnd" & i).Tag) ^ 2) + retVal End If Next i i = 2 Set rng = ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) Do While rng <> "" Select Case retVal Case 1 'imie If ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) = Me.TxtFnd1 Then UsunDane i End If Case 5 'imie + nazwisko If ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) = Me.TxtFnd1 And _ ThisWorkbook.Worksheets("Arkusz1".Range("B" & i) = Me.TxtFnd2 Then UsunDane i End If Case 14 'imie + nazwisko + adres If ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) = Me.TxtFnd1 And _ ThisWorkbook.Worksheets("Arkusz1".Range("B" & i) = Me.TxtFnd2 And _ ThisWorkbook.Worksheets("Arkusz1".Range("C" & i) = Me.TxtFnd3 Then UsunDane i End If Case 10 'imie + adres If ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) = Me.TxtFnd1 And _ ThisWorkbook.Worksheets("Arkusz1".Range("C" & i) = Me.TxtFnd3 Then UsunDane i End If Case 4 'nazwisko If ThisWorkbook.Worksheets("Arkusz1".Range("B" & i) = Me.TxtFnd2 Then UsunDane i End If Case 13 'nazwisko + adres If ThisWorkbook.Worksheets("Arkusz1".Range("B" & i) = Me.TxtFnd2 And _ ThisWorkbook.Worksheets("Arkusz1".Range("C" & i) = Me.TxtFnd3 Then UsunDane i End If Case 9 'adres If ThisWorkbook.Worksheets("Arkusz1".Range("C" & i) = Me.TxtFnd3 Then UsunDane i End If Case Else MsgBox "Wyszukiwanie nie jest możliwe!" & vbCr & "Wystapił błąd wewnętrzny!", vbExclamation, "Błąd!!!" Exit Sub End Select i = i + 1 Set rng = ThisWorkbook.Worksheets("Arkusz1".Range("A" & i) Loop Exit_CmdOK_Click: On Error Resume Next Set rng = Nothing Unload Me Exit Sub Err_CmdOK_Click: Resume Exit_CmdOK_Click End Sub Private Sub UsunDane(wiersz As Long) ThisWorkbook.Worksheets("Arkusz1".Range(wiersz & ":" & wiersz).Copy ThisWorkbook.Worksheets("Arkusz2".Range("A" & PierwszyPusty()).PasteSpecial xlValues ThisWorkbook.Worksheets("Arkusz1".Range(wiersz & ":" & wiersz).Delete End Sub Private Function PierwszyPusty() Dim i i = 1 Do While ThisWorkbook.Worksheets("Arkusz2".Range("A" & i) <> "" i = i + 1 Loop PierwszyPusty = i End Function _____________________________________________ POSTULATY STARUSZKA: 1) Ludzie, dbajcie o polszczyznę!!! 2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!! Powodzenia Maciej Łoś 13-02-2005 12:40 anonim Typ: Nie zarejestrowany wielki dzieki macku za szybka odpowiedz,zaraz bede kombinowal jak to zastosowac w swoim programie ps: jesli to nie pomoze,to bede mogl ci przeslac program,to wtedy bedzie bardziej widoczne jeszcze raz wielkie DZIENX 13-02-2005 13:33 Wszystkich odpowiedzi: 3 :: Maxymalnie na stronę: 20 Strona: [ > ] z 1 |