Strona: [  << <   1   > >>  ]  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
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
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: [  << <   1   > >>  ]  z  1