Excel - Søk og Display-spørring

Utgave

Jeg er en ikke-IT-person. Jeg har et enkelt krav, men vet ikke hvordan jeg skal gå.

Kravet er

 Mine data. Sno Release Project Kontaktpersoner 1 Apr SYL Sam, Mark, Tom 2. mai Xim Tom, Frank, Kim 3. juni TIG Kim, David, Sam

Mitt krav er når jeg søker etter prosjekt eller ved utgivelse,, Jeg trenger å få alle kontaktpersonen navnene .. På samme måte hvis jeg søker etter kontaktperson navn .. Eg Sam i eksemplet ovenfor. Utmerket må vise meg alle prosjektene som Sam var involvert med alle relevante data som Release etc ... Dette må vises i et nytt ark i Excel.

Er det mulig å gjøre i Excel eller jeg må prøve noe annet? Kan du hjelpe meg med å gjøre dette?

Løsning

Antagelser:

1. Navn på arket der dataene er "Sheet1" (korrigér koden hvis den ikke er)
2. Navnet på arket der søkeresultatet skal legges inn, er "Resultat" (korrigér koden hvis den ikke er)
3. Tidligere søkeresultater skal kasseres
4. Data er på 4 kolonner (som i prøve)

TRINN:

1. Les antagelser
2. Lag en sikkerhetskopi
3. Trykk ALT + F11 samtidig for å gå inn i VBE-miljøet
4. Klikk på "Sett inn" og legg til en ny modul
5. Lim inn koden (etter instruksjonene)
6. Kjør koden

Kode:

 Sub SearchData () Dim lMaxRows Så lenge 'maks antall rader med data basert på celler som brukes i kolonne A Dim lFilterRows Så lenge sist filtrert rad Dim søkRel som variant' hva skal søkes etter Release Info Dim searchProj As Variant 'hva er å søke etter Prosjektinfo Dim søkPpl Som variant 'Hva skal søkes etter Kontaktinfo Dim sDataSheet As String' navn på databladet Dim sResultSheet As String 'navn på resultatarket sDataSheet = "Sheet1"' navn på databladet sResultSheet = "Resultat" 'navn på resultatarket' får søkekriterier searchRel = InputBox ("Hvilken utgave du vil søke. For å hoppe over, trykk bare OK.") searchProj = InputBox ("Hvilket prosjekt du vil søke., trykk bare OK. ") searchPpl = InputBox (" Hvilken kontaktperson du vil søke. For å hoppe over, trykk bare OK. ") 'Fjern hvite mellomrom searchRel = Trim (searchRel) searchProj = Trim (searchProj) searchPpl = Trim ) 'hvis alle tre søkekriteriene er tomme, gjør ikke noe hvis (Len (searchRel & searchProj & searchPpl) = 0) Deretter Avslutt Del På Feil Fortsett Neste Application.DisplayAlerts = False 'Slett det forrige resultatarket hvis det eksisterer Ark (sResultSheet) .Delete Application.DisplayAlerts = True On Error GoTo 0' Legg til resultatarket Sheets.Add ActiveSheet.Name = sResultSheet Sheets (sDataSheet) .Velg Cells.Select 'fjerne et filter hvis ActiveSheet.AutoFilterMode deretter på feil fortsette neste ActiveSheet.ShowAllData på feil GoTo 0 End Hvis lMaxRows = Cells (Rows.Count, "A"). End (xlUp) .Row Hvis ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter Slutt Hvis Hvis (searchRel) "" Så Selection.AutoFilter Field: = 2, Kriterier1: = "=" & searchRel, Operator: = xlAnd, Criteria2: = " "End If If (searchProj)" "Så Selection.AutoFilter Field: = 3, Kriterier1: =" = "& searchProj, Operator: = xlAnd, Criteria2: =" "Slutt hvis If (searchPpl)" "Så Selection.AutoFilter Field : = 4, Criteria1: = "= *" & searchPpl & "*", Operator: = xlAnd, Criteria2: = "" Slutt hvis lFilterRows = Cells (Rows.Count, "A"). End (xlUp) .Row Range ( "A1: D" & lFilterRows) .Copy Sheets (sResultSheet) .Velg Range ("A1"). Velg ActiveSheet.Paste Sheets (sDataSheet) .Velg Cells.Select 'fjern et filter Hvis ActiveSheet.AutoFilterMode Deretter På Feil Fortsett Neste ActiveSheet.ShowAllData On Error GoTo 0 Slutt hvis sluttdel