sorteermacro

[hazesoft]

In Excel heb in een map met diverse werkbladen, waarvan 10 voor de basisscholen in Tubbergen. Ieder school heeft dus een apart werkblad.
De bedoeling is om software voor diverse scholen te registreren met diverse kenmerken.
Hoe kan ik nu een macro maken om in één oogopslag te zien welke scholen een bepaald programma op het netwerk hebben geïnstalleerd?
Ik heb een apart blad met één cel (de rest van de kolommen en rijen heb ik verwijderd) met een knop, waaraan die macro moet worden toegewezen.
Heb van alles geprobeerd, maar ik kom niet verder dan dat de 10 werkbladen geselecteerd worden. Het zoekscherm is dan weer verdwenen!!!!!

In MS-Access gaat het prima, maar mijn collega's en ook ikzelf zijn helemaal weg van MS-Excel.

Graag hulp!!!!!

 

[Jan van Asseldonk]

Voorbeeldje in bijlage (gezipt) zou gemakkelijk zijn.

 

[hazesoft]

bijlage

Hallo Jan,

Heb in het bericht eeb bijlage bijgesloten, maar zie hem niet terug

Groeten,
Hans

 

[hazesoft]

bijlage

Hallo Jan,

Merkte dat de bijlage zelfs gezipped te groot was.
Heb daarom enkele werkbladen weggelaten.

Hans

 

[hazesoft]

Heeft iemand nog een andere oplossing?

 

[Jan van Asseldonk]

Zie bijlage.
Programmanaam moet wel exact overeenkomen!
Hoop dat dit je verder helpt.

 

[Jan van Asseldonk]

Nieuwe poging voor bijlage:

Bijlage blijft te groot.

Kopieer onderstaande code naar een module en koppel die aan je zoekknop.

Sub zoeken()
'
' zoeken Macro
'
Dim zoekprg, gevonden As String
Dim i As Integer

zoekprg = InputBox("Welk programma zoekt u?", "Zoeken")
For i = 1 To Sheets.Count
Sheets(i).Select
Range("B2").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = zoekprg Then
If gevonden = "" Then
gevonden = gevonden & Range("A1").Value
Else
gevonden = gevonden & vbCrLf & Range("A1").Value
End If
End If
ActiveCell.Offset(1, 0).Select
Wend
Next i
MsgBox ("Het programma komt voor op de " & vbCrLf & gevonden)
End Sub

 

[hazesoft]

Bedankt Jan.
De routine loopt in ieder geval zoekend alle sheets af.
Krijg alleen nog niet in beeld op welke sheet welk programma (kolom A vanaf rij 3) gevonden is.

 

[hazesoft]

Graag wil bv. als resultaat:
"Het programma komt voor op blad 1, 3, 4 en 8"
Liever nog zoiets als:
"AmbraSoft komt voor op blad 1, 3, 4 en 8"
Dit is misschien wel te veel gevraagd.
Heb een zip-bestand bijgevoegd, waarbij ik, omwille van de grootte enkele sheets heb weggelaten.

 

[hazesoft]

Nogmaals het gezipte bestand

 

[Jan van Asseldonk]

Voor

Graag wil bv. als resultaat:
"Het programma komt voor op blad 1, 3, 4 en 8"

het volgende aanpassen in de code

gevonden = gevonden & vbCrLf & Range("A1").Value
vervangen door
gevonden = gevonden & ActiveSheet.Name

gevonden = gevonden & vbCrLf & Range("A1").Value
vervangen door
gevonden = gevonden & ", " & ActiveSheet.Name

en

MsgBox ("Het programma komt voor op de " & vbCrLf & gevonden)
wijzigen in
MsgBox ("Het programma komt voor op blad " & gevonden)

Voor

Liever nog zoiets als:
"AmbraSoft komt voor op blad 1, 3, 4 en 8"

dan na bovenstaande wijzigingen
MsgBox ("Het programma komt voor op blad " & gevonden)
wijzigen in
MsgBox (zoekprg & " komt voor op blad " & gevonden)

 

[hazesoft]

Bedankt Jan.
Wat een tempo.
Ziet er veelbelovend uit. Ga het vanavond uitproberen.

 

[hazesoft]

Hallo Jan,
Heb de code als volgt aan gepast:

Sub zoeken()
'
' zoeken Macro
'
Dim zoekprg, gevonden As String
Dim i As Integer

zoekprg = InputBox("Welk programma zoekt u?", "Zoeken")
For i = 1 To Sheets.Count
Sheets(i).Select
Range("A3").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = zoekprg Then
If gevonden = "" Then
gevonden = gevonden & ActiveSheet.Name
Else
gevonden = gevonden & ", " & ActiveSheet.Name
End If
End If
ActiveCell.Offset(1, 0).Select
Wend
Next i
MsgBox (zoekprg & " komt voor op de volgende sheets:" & vbCrLf)
End Sub

Wanneer is nu ga zoeken op een pakket uit kolom A,
krijg ik een melding als:

AmbraSoft komt voor op de volgende sheets:

De namen van de sheets (1, 2, 3, enz) komen niet in beeld.

Kun je dit nog voor elkaar sleutelen?

Heb trouwens Range("B2").Select veranderd in
Range("A3").Select
Dat is toch goed hè? Hij moet beginnen te zoeken in cel A3.

 

[hazesoft]

Nog een poging een bijlage te sturen. Heb hierbij veel sheets weggelaten.

 

[hazesoft]

Hallo Jan,

Voor de End Sub heb ik het volgende geplaatst:

For i = 1 To Sheets.Count - 1
MsgBox (zoekprg & " komt voor op de volgende sheets:" & (i) & vbCrLf)
Next i

Kun je hier iets mee?

 

[jpvs]

Met dit werkt het :

Sub zoeken()

Dim zoekprg, gevonden As String
Dim i As Integer

zoekprg = InputBox("Welk programma zoekt u?", "Zoeken")
For i = 1 To Sheets.Count
Sheets(i).Select
Range("B2").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = zoekprg Then
If gevonden = "" Then
gevonden = gevonden & Range("A1").Value
Else
'gevonden = gevonden & vbCrLf & Range("A1").Value
'gevonden = gevonden & ActiveSheet.Name
'of
gevonden = gevonden & ", " & ActiveSheet.Name

End If
End If
ActiveCell.Offset(1, 0).Select
Wend
Next i
'MsgBox ("Het programma komt voor op de " & vbCrLf & gevonden)
MsgBox ("Het programma komt voor op blad " & gevonden)

End Sub

Pierre

 

[hazesoft]

Hallo Pierre,

Bedankt voor je reactie, maar jammer: werkt niet.
Heb een kleine aanpassing gedaan: Range("A3").Select
omdat hij in iedere sheet vanaf cel A3 moet zoeken.
Maar helaas het werkt nog steeds niet.

 

[hazesoft]

Sorry, maar snap niet wat je bedoelt.

 

[jpvs]

Probeer het bestand te plaatsen maar lukt niet???

Pierre

 

[hazesoft]

Mag niet groter zijn dan 102400 bytes.