Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

Hilfe beim Makro

Betrifft: Hilfe beim Makro
von: Peter Sasse
Geschrieben am: 20.04.2003 - 19:52:32

Hallo,wer kennt sich damit aus?.Ich sitze nun schon Stunden daran und
versuche dieses Makro so Umzugestalten das ich es für meine Tabelle
benutzen kann,leider ist es mir bisher nicht gelungen.
Meine Tab. sieht wie folgt aus.
in Spalte A Zeile 35 bis 150 steht eine 7 Stellige Nr. die gesucht werden
soll und in der Zeile 20 soll die Fundstelle hinein kopiert werden.
Vieleicht kann sich das mal jemand anschauen.
MfG
Peter Sasse


Sub FindenUndKopieren()
Dim iRowS As Integer, iRowT As Integer
Dim sWord As String
sWord = InputBox( _
prompt:="Suchbegriff:", _
Default:="Zeile 3 - Spalte 1")
If sWord = "" Then Exit Sub
iRowS = 1
iRowT = 1
With Worksheets("Tabelle2")
Do Until IsEmpty(Cells(iRowS, 1))
If Cells(iRowS, 1) = sWord Then
Rows(iRowS).Copy .Rows(iRowT)
iRowT = iRowT + 1
End If
iRowS = iRowS + 1
Loop
.Columns.AutoFit
.Select
End With
End Sub

  

Re: Hilfe beim Makro
von: moe
Geschrieben am: 20.04.2003 - 19:58:32

Hallo Peter

Schick mir die datei zu dann bastel ich dir was hast du wirklich
excel 5/7 .

gruss

moe

  

Re: Hilfe beim Makro
von: Forum
Geschrieben am: 20.04.2003 - 20:01:24

Hallo Peter

Deine angegebene Version kann diesen Code noch nicht verarbeiten. Diese Art der Programmierung gibt es erst ab Version 97
Mal als Ansatz ab Version 97


Sub Peter()
'   erstellt von Hajo.Ziplies@web.de 12.04.03
    Dim Found As Range
    Dim sSearch As String
    sSearch = InputBox("Suchbegriff:", , "test")
    If sSearch = "" Then Exit Sub
    Set Found = Range("A35:A150").Find(sSearch, Range("A150"), , xlPart, , xlNext)
    If Found Is Nothing Then Exit Sub  'falls nicht gefunden wird sub verlassen
    Range(Found.Address).Copy Destination:=Range("A20")
End Sub

Gruß Hajo
Der Code wurde getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

  

Re: Hilfe beim Makro
von: Peter Sasse
Geschrieben am: 20.04.2003 - 21:54:35

Hallo,Hajo besten Dank für deine sehr schnelle Antwort.Leider habe ich einen Fehler bei meiner Beschreibung gemacht es sollte der gesamte Zeileninhalt nach Zeile 20 kopiert werden.Die zu suchende Nr. befindet sich in Zelle A aber in Zelle B bis D stehen noch Informationen die zu dieser Nr. in Zelle A gehören.
MfG
Peter

  

Re: Hilfe beim Makro
von: moe
Geschrieben am: 21.04.2003 - 02:17:33

Du hast Post

  

Re: Hilfe beim Makro
von: Forum
Geschrieben am: 21.04.2003 - 07:15:45

Hallo Peter


Sub Peter()
'   erstellt von Hajo.Ziplies@web.de 12.04.03
    Dim Found As Range
    Dim sSearch As String
    sSearch = InputBox("Suchbegriff:", , "test")
    If sSearch = "" Then Exit Sub
    Set Found = Range("A35:A150").Find(sSearch, Range("A150"), , xlPart, , xlNext)
    If Found Is Nothing Then Exit Sub  'falls nicht gefunden wird sub verlassen
    Range(Cells(Found.Row, 1), Cells(Found.Row, 4)).Copy Destination:=Range("A20")
End Sub

Gruß Hajo
Der Code wurde getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

  

Re: Hilfe beim Makro
von: Peter Sasse
Geschrieben am: 21.04.2003 - 08:03:35

Alles besten,Danke für deine Hilfe.Wünsche noch einen schönen Feiertag. Danke
MfG
Peter

  

Re: Hilfe beim Makro
von: Peter Sasse
Geschrieben am: 21.04.2003 - 08:05:41

Besten Dank,wünsche noch einen schönen Feiertag.
Danke.
MfG
Peter

  

Re: Hilfe beim Makro
von: Forum
Geschrieben am: 21.04.2003 - 08:07:23

Hallo moe

sollten Probleme nicht im Forum geklärt werden. Damit die anderen die mitlesen auch was von der Lösung haben??

Gruß Hajo
Der Code wurde getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

  

Re: Hilfe beim Makro
von: moe
Geschrieben am: 22.04.2003 - 00:58:10

Ja Hajo hast recht

Sorry

Gruss


Moe