iceage
Mar 31, 2014, updated at Apr 01, 2014 (UTC)
view2646
view8
0
Goto Top

Excel 2010 Hilfe bei Makro

GermansolvedQuestionVisual StudioDevelopment
Hallo Liebe Adminstratoren,

ich bräuchte mal eure Unterstützung bei einem Excel Makro. Ich habe eine Excelliste mit 2 Tabellen. Die erste lautet Artikelliste und beinhaltet sämtliche Artikel. Die 2.Tabelle heisst Kalkulation. Hier möchte ich in eine Zelle springen dann via Tastenkombination das folgende Suchmakro starten. Im groben funktioniert dies auch, nun möchte ich das die Artikelnummer des gefundenen Artikels in die Zeile kopiert, von der ich am Anfang das Makro gestartet habe. Der Fehler liegt vermutlich in einer der letzten Zeilen. Jemand eine Idee? Vielen Dank für eure Unterstützung. Grüße Ice

Sub Artikelsuche()
Dim rng As Range
Dim sBegriff As String, sAddress As String

Dim strActiveCell As String
strActiveCell = ActiveCell.Address
MsgBox strActiveCell
Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig  
sBegriff = InputBox( _
  prompt:="Bitte Suchbegriff eingeben:", _  
  Default:="531351")  
If sBegriff = "" Then Exit Sub  
Set rng = Columns("A:D").Find( _  
  What:=sBegriff, _
  LookAt:=xlWhole, _
  LookIn:=xlValues, _
  MatchCase:=False, _
  After:=Cells(Rows.Count, 3))
If rng Is Nothing Then
  Beep
  MsgBox "Suchbegriff nicht gefunden!", , _  
    Application.UserName
  Exit Sub
End If
sAddress = rng.Address
rng.Select
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then  
  rng.Offset(1).Select
  Do
    Columns("A:D").FindNext(After:=ActiveCell).Activate  
    If ActiveCell.Address = sAddress Then Exit Sub
    If (MsgBox(ActiveCell.Address(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do  
  Loop
End If

Sheets("Kalkulation").Select  
strActiveCell = Sheets("Artikelliste").Cells(ActiveCell.Row, 2)  

End Sub

[Edit Biber] Codeformatierung. [/Edit]
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 234096

Url: https://administrator.de/contentid/234096

Printed on: April 19, 2024 at 09:04 o'clock

8 Comments
Latest comment
Goto Top
Member: colinardo
Solution colinardo Mar 31, 2014, updated at Apr 01, 2014 at 10:16:09 (UTC)
Goto Top
Excel, Suche, Makro....
hatten wir gerade erst hier(inkl. Demosheet zum abgucken): MAKRO EXCEL bestimmten Zahlen von einem Arbeitsblatt X in ein neues Arbeitsblatt Z kopieren

Grüße Uwe
Member: IceAge
IceAge Mar 31, 2014 at 19:05:19 (UTC)
Goto Top
Hallo Uwe,

danke für deinen Tipp. Habe mir grad mal das Demosheet zu Gemüte geführt. Meine Suchfunktion funktioniert ja bereits und es wird auch das richtige Ergebnis in die Zelle geschrieben wenn ich eine feste Zelle vorgebe. Ich möchte aber dass das Ergebnis nicht in eine feste Zelle geschrieben wird, sondern in die Zelle in der such der Cursor am Anfang (also beim Auslösen des Makros) befindet. Hast ne Idee was an den letzten 2-3 Zeilen (Zeile 36/37) falsch sein könnte?
Member: colinardo
Solution colinardo Mar 31, 2014, updated at Apr 01, 2014 at 10:16:12 (UTC)
Goto Top
Zitat von @IceAge:
Auslösen des Makros) befindet. Hast ne Idee was an den letzten 2-3 Zeilen (Zeile 36/37) falsch sein könnte?
klar, du selektierst hier das zweite Sheet, und dann verweist du auf ActiveCell , das ist aber wenn du mit Select das zweite Sheet aktivierst nicht mehr die alte Zelle in Sheet 1 sondern nun eine Zelle in Sheet 2!!
Du solltest hier mit Referenzen arbeiten und dich nicht immer an ActiveCell orientieren.
Lege also am Anfang die Zelle fest in der du das gefundene hineinschreiben willst:
set startZelle = ActiveCell
dann kannst du nachher auf diese Zelle verweisen und den Inhalt direkt dort hinein schreiben, ohne wieder mit .Select manuell hin und her zu wechseln, das ist schlechter und anfälliger Programmierstil!

Zuweisen eines Wertes zu deiner Zelle
startZelle.Value = rng.Value
Member: IceAge
IceAge Apr 01, 2014 updated at 06:26:44 (UTC)
Goto Top
Guten Morgen Uwe,

bin leider kein Programmierer, versuche mich nur etwas einzuarbeiten um die ein oder andere tägliche Aufgabe etwas runder zu gestalten. Dank deines Tipps schreibe ich nun das Ergebnis der Suche in die richtige Zelle:

Sub Artikelsuche()
Dim rng As Range
Dim sBegriff As String, sAddress As String

Set startZelle = ActiveCell

Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig  
sBegriff = InputBox( _
  prompt:="Bitte Suchbegriff eingeben:", _  
  Default:="Demo")  
If sBegriff = "" Then Exit Sub  
Set rng = Columns("A:D").Find( _  
  What:=sBegriff, _
  LookAt:=xlWhole, _
  LookIn:=xlValues, _
  MatchCase:=False, _
  After:=Cells(Rows.Count, 3))
If rng Is Nothing Then
  Beep
  MsgBox "Suchbegriff nicht gefunden!", , _  
    Application.UserName
  Exit Sub
End If
sAddress = rng.Address
rng.Select
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then  
  rng.Offset(1).Select
  Do
    Columns("A:D").FindNext(After:=ActiveCell).Activate  
    If ActiveCell.Address = sAddress Then Exit Sub
    If (MsgBox(ActiveCell.Address(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do  
  Loop
End If

Sheets("Kalkulation").Select  
startZelle.Value = Sheets("Artikelliste").Cells(ActiveCell.Row, 2)  
End Sub

Nun ist mir aufgefallen, dass etwas am Suchergebnis, welches in die Zelle geschrieben wird nicht mehr stimmt. Zudem würde ich gern den Suchbereich auf die Spalte A:D (nur im Sheet Artikelliste) ausbreiten. Könntest du mir diesbezüglich auch weiterhelfen?

Wenn ich das Ergebnis in eine feste Zelle ausgeben würde, stimmt seltsamerweise auch wieder das Suchergebnis... Nur bei der Ausgabe in die StartZelle erhalte ich Murks.
Sheets("Kalkulation").Cells(15, 1) = Sheets("Artikelliste").Cells(ActiveCell.Row, 2)
Member: colinardo
Solution colinardo Apr 01, 2014 updated at 10:15:43 (UTC)
Goto Top
Zitat von @IceAge:
Nun ist mir aufgefallen, dass etwas am Suchergebnis, welches in die Zelle geschrieben wird nicht mehr stimmt. Zudem würde ich
gern den Suchbereich auf die Spalte A:D (nur im Sheet Artikelliste) ausbreiten. Könntest du mir diesbezüglich auch
weiterhelfen?
siehe weiter unten
Wenn ich das Ergebnis in eine feste Zelle ausgeben würde, stimmt seltsamerweise auch wieder das Suchergebnis... Nur bei der
Ausgabe in die StartZelle erhalte ich Murks.
deswegen habe ich oben erwähnt das du dich nicht an ActiveCell halten solltest sondern den Ergebnis-Range(rng) nehmen sollst.
Wenn z.B. der Wert der übernommen werden soll, eine Zelle rechts vom Suchwert liegt machst du dies so
startZelle.Value = rng.Offset(0,1).Value
steht der Wert immer in der zweiten Spalte steht, egal wo der Suchbegriff in der Zeile gefunden wurde kannst du dies so machen:
startZelle.Value = Worksheets("Artikelliste").Cells(rng.Row, 2).Value

Hier mal das ganze zusammengefasst:
Sub Artikelsuche()
    Dim rng As Range, startZelle As Range
    Dim sBegriff As String
    Set startZelle = ActiveCell
    
    Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig  
    sBegriff = InputBox( _
      prompt:="Bitte Suchbegriff eingeben:", Default:="Demo")  
    If sBegriff = "" Then Exit Sub  
    
    With Worksheets("Artikelliste").Columns("A:D")  
        Set rng = .Find(What:=sBegriff, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Cells(Rows.Count, 3))
        If Not rng Is Nothing Then
            firstAddress = rng.Address
            Do
                ' Suchbegriff gefunden, selektiere Zelle nur für's Visuelle  
                rng.Select
                ' Abfrage weitersuchen ?  
                If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then  
                    Set rng = .FindNext(rng)
                Else
                    ' Werte in Zielzelle schreiben  
                    Worksheets("Kalkulation").Select  
                    startZelle.Value = Worksheets("Artikelliste").Cells(rng.Row, 2).Value  
                    ' Loop verlassen  
                    Exit Do
                End If
            Loop While Not rng Is Nothing And rng.Address <> firstAddress
        Else
            'Suchbegriff nicht gefunden  
            Beep
            MsgBox "Suchbegriff nicht gefunden!", , Application.UserName  
            Exit Sub
        End If
    End With
End Sub

Grüße Uwe
heart1
Member: IceAge
IceAge Apr 01, 2014 at 08:18:47 (UTC)
Goto Top
Guten Morgen Uwe,

vielen Dank. Du bist ein Schatz face-smile Makro läuft. Darf ich dich noch um eine Kleinigkeit bitten? In der Zeile 19 wird ja in der MsgBox die Zelle (z.B.A25) ausgegeben. Könnte ich hier auch den Inhalt (also den Produktnamen) ausgeben lassen?

Vielen Dank und Gruß

Ice
Member: colinardo
Solution colinardo Apr 01, 2014 updated at 10:15:40 (UTC)
Goto Top
Zitat von @IceAge:
vielen Dank. Du bist ein Schatz face-smile Makro läuft. Darf ich dich noch um eine Kleinigkeit bitten? In der Zeile 19 wird ja in
der MsgBox die Zelle (z.B.A25) ausgegeben. Könnte ich hier auch den Inhalt (also den Produktnamen) ausgeben lassen?
klar...: (weiß aber nicht wo der steht ...)
If (MsgBox(rng.Value, vbYesNo, "Weitersuchen?")) = vbYes Then
face-smile Uwe
heart1
Member: IceAge
IceAge Apr 01, 2014 updated at 08:27:11 (UTC)
Goto Top
Hallo Uwe,

perfekt. Ich danke dir und schließe dich für den Rest der Woche ins Abendgebet ein face-wink

Grüße Ice
GermansolvedQuestionVisual StudioDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsgleixnerdCheck of ZFW Firewallgleixnerd - 2 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment