Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Frage Entwicklung Visual Studio

GELÖST

Excel 2010 Hilfe bei Makro

Mitglied: IceAge

IceAge (Level 2) - Jetzt verbinden

31.03.2014, aktualisiert 01.04.2014, 1659 Aufrufe, 8 Kommentare, 2 Danke

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

01.
Sub Artikelsuche() 
02.
Dim rng As Range 
03.
Dim sBegriff As String, sAddress As String 
04.
 
05.
Dim strActiveCell As String 
06.
strActiveCell = ActiveCell.Address 
07.
MsgBox strActiveCell 
08.
Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig 
09.
sBegriff = InputBox( _ 
10.
  prompt:="Bitte Suchbegriff eingeben:", _ 
11.
  Default:="531351") 
12.
If sBegriff = "" Then Exit Sub 
13.
Set rng = Columns("A:D").Find( _ 
14.
  What:=sBegriff, _ 
15.
  LookAt:=xlWhole, _ 
16.
  LookIn:=xlValues, _ 
17.
  MatchCase:=False, _ 
18.
  After:=Cells(Rows.Count, 3)) 
19.
If rng Is Nothing Then 
20.
  Beep 
21.
  MsgBox "Suchbegriff nicht gefunden!", , _ 
22.
    Application.UserName 
23.
  Exit Sub 
24.
End If 
25.
sAddress = rng.Address 
26.
rng.Select 
27.
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then 
28.
  rng.Offset(1).Select 
29.
  Do 
30.
    Columns("A:D").FindNext(After:=ActiveCell).Activate 
31.
    If ActiveCell.Address = sAddress Then Exit Sub 
32.
    If (MsgBox(ActiveCell.Address(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do 
33.
  Loop 
34.
End If 
35.
 
36.
Sheets("Kalkulation").Select 
37.
strActiveCell = Sheets("Artikelliste").Cells(ActiveCell.Row, 2) 
38.
 
39.
End Sub
[Edit Biber] Codeformatierung. [/Edit]
Mitglied: colinardo
LÖSUNG 31.03.2014, aktualisiert 01.04.2014
Excel, Suche, Makro....
hatten wir gerade erst hier(inkl. Demosheet zum abgucken): http://www.administrator.de/forum/makro-excel-bestimmten-zahlen-von-ein ...

Grüße Uwe
Bitte warten ..
Mitglied: IceAge
31.03.2014 um 21:05 Uhr
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?
Bitte warten ..
Mitglied: colinardo
LÖSUNG 31.03.2014, aktualisiert 01.04.2014
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
Bitte warten ..
Mitglied: IceAge
01.04.2014, aktualisiert um 08:26 Uhr
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:

01.
Sub Artikelsuche() 
02.
Dim rng As Range 
03.
Dim sBegriff As String, sAddress As String 
04.
 
05.
Set startZelle = ActiveCell 
06.
 
07.
Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig 
08.
sBegriff = InputBox( _ 
09.
  prompt:="Bitte Suchbegriff eingeben:", _ 
10.
  Default:="Demo") 
11.
If sBegriff = "" Then Exit Sub 
12.
Set rng = Columns("A:D").Find( _ 
13.
  What:=sBegriff, _ 
14.
  LookAt:=xlWhole, _ 
15.
  LookIn:=xlValues, _ 
16.
  MatchCase:=False, _ 
17.
  After:=Cells(Rows.Count, 3)) 
18.
If rng Is Nothing Then 
19.
  Beep 
20.
  MsgBox "Suchbegriff nicht gefunden!", , _ 
21.
    Application.UserName 
22.
  Exit Sub 
23.
End If 
24.
sAddress = rng.Address 
25.
rng.Select 
26.
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then 
27.
  rng.Offset(1).Select 
28.
  Do 
29.
    Columns("A:D").FindNext(After:=ActiveCell).Activate 
30.
    If ActiveCell.Address = sAddress Then Exit Sub 
31.
    If (MsgBox(ActiveCell.Address(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do 
32.
  Loop 
33.
End If 
34.
 
35.
Sheets("Kalkulation").Select 
36.
startZelle.Value = Sheets("Artikelliste").Cells(ActiveCell.Row, 2) 
37.
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.
01.
Sheets("Kalkulation").Cells(15, 1) = Sheets("Artikelliste").Cells(ActiveCell.Row, 2)
Bitte warten ..
Mitglied: colinardo
LÖSUNG 01.04.2014, aktualisiert um 12:15 Uhr
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:
01.
Sub Artikelsuche() 
02.
    Dim rng As Range, startZelle As Range 
03.
    Dim sBegriff As String 
04.
    Set startZelle = ActiveCell 
05.
     
06.
    Sheets("Artikelliste").Select 'bei Start auf der Tabelle nicht nötig 
07.
    sBegriff = InputBox( _ 
08.
      prompt:="Bitte Suchbegriff eingeben:", Default:="Demo") 
09.
    If sBegriff = "" Then Exit Sub 
10.
     
11.
    With Worksheets("Artikelliste").Columns("A:D") 
12.
        Set rng = .Find(What:=sBegriff, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False, After:=Cells(Rows.Count, 3)) 
13.
        If Not rng Is Nothing Then 
14.
            firstAddress = rng.Address 
15.
            Do 
16.
                ' Suchbegriff gefunden, selektiere Zelle nur für's Visuelle 
17.
                rng.Select 
18.
                ' Abfrage weitersuchen ? 
19.
                If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then 
20.
                    Set rng = .FindNext(rng) 
21.
                Else 
22.
                    ' Werte in Zielzelle schreiben 
23.
                    Worksheets("Kalkulation").Select 
24.
                    startZelle.Value = Worksheets("Artikelliste").Cells(rng.Row, 2).Value 
25.
                    ' Loop verlassen 
26.
                    Exit Do 
27.
                End If 
28.
            Loop While Not rng Is Nothing And rng.Address <> firstAddress 
29.
        Else 
30.
            'Suchbegriff nicht gefunden 
31.
            Beep 
32.
            MsgBox "Suchbegriff nicht gefunden!", , Application.UserName 
33.
            Exit Sub 
34.
        End If 
35.
    End With 
36.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: IceAge
01.04.2014 um 10:18 Uhr
Guten Morgen Uwe,

vielen Dank. Du bist ein Schatz 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
Bitte warten ..
Mitglied: colinardo
LÖSUNG 01.04.2014, aktualisiert um 12:15 Uhr
Zitat von IceAge:
vielen Dank. Du bist ein Schatz 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 
Uwe
Bitte warten ..
Mitglied: IceAge
01.04.2014, aktualisiert um 10:27 Uhr
Hallo Uwe,

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

Grüße Ice
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Excel Makro
Frage von maloh1984Microsoft Office4 Kommentare

Hallo Habe ein Problem, ein Kunde der hat Excellisten mit Makro die lassen sich öffnen aber die Buttons reagieren ...

Microsoft Office
Excel-Makro
gelöst Frage von yuki13Microsoft Office7 Kommentare

Hallo Zusammen!! :-) Ich bin nicht so fit in Excel Makros und wollte mich hier erkundigen, ob mir jemand ...

Microsoft Office
Excel 2010 via Makro bedingten Seitenumbruch einfügen
Frage von arduinoMicrosoft Office1 Kommentar

Hallo Ich hab ein ExcelMakro, das ein formatiertes Textfile importiert Jetzt ist der Wunsch, dass nach den Eintritten von ...

Microsoft Office
Excel 2010 : Makro kann pwd-Datei nicht finden
Frage von freeskierchrisMicrosoft Office2 Kommentare

Hallo, ich habe ein Excel-Dokument, dass ein Makro enthält. Zum Ausführen des Makros benötigt excel eine pwd-Datei , die ...

Neue Wissensbeiträge
Linux

Meltdown und Spectre: Linux Update

Information von Frank vor 2 TagenLinux

Meltdown (Variante 3 des Prozessorfehlers) Der Kernel 4.14.13 mit den Page-Table-Isolation-Code (PTI) ist nun für Fedora freigegeben worden. Er ...

Tipps & Tricks

Solutio Charly Updater Fehlermeldung: Das Abgleichen der Dateien in -Pfad- mit dem Datenobject ist fehlgeschlagen

Tipp von StefanKittel vor 3 TagenTipps & Tricks

Hallo, hier einmal als Tipp für alle unter Euch die mit der Zahnarztabrechnungssoftware Charly von Solutio zu tun haben. ...

Sicherheit

Meltdown und Spectre: Wir brauchen eine "Abwrackprämie", die die CPU-Hersteller bezahlen

Information von Frank vor 3 TagenSicherheit12 Kommentare

Zum aktuellen Thema Meltdown und Spectre: Ich wünsche mir von den CPU-Herstellern wie Intel, AMD oder ARM eine Art ...

Sicherheit

Meltdown und Spectre: Realitätscheck

Information von Frank vor 3 TagenSicherheit12 Kommentare

Die unangenehme Realität Der Prozessorfehler mit seinen Varianten Meltdown und Spectre ist seit Juni 2017 bekannt. Trotzdem sind immer ...

Heiß diskutierte Inhalte
Firewall
Penetrationstester-Labor - Firewalls
Frage von Oli-nuxFirewall10 Kommentare

Mich würde interessieren warum man beim Einrichten eines Penetrationstester-Labor (VMs) die Firewall der Systeme deaktivieren soll? Hat das nur ...

SAN, NAS, DAS
Wer kennt sich mit QNAP und CISCO aus ?
gelöst Frage von MachelloSAN, NAS, DAS9 Kommentare

Hallo Zusammen hier im Forum, Ich habe ein QNas 451+ und dieses NAS hat zwei GBit Lan Adapter die ...

Netzwerkgrundlagen
IPv6 Inter-VLAN Routing
gelöst Frage von clSchakNetzwerkgrundlagen9 Kommentare

Hi ich befasse mich gerade mit der Implementierung von IPv6 was bisher (in einem VLAN) korrekt funktioniert inkl. DNS ...

Windows Netzwerk
Zugriff auf den Desktop Ordner eines anderen Rechners in der gleichen Domäne
gelöst Frage von JensNomaWindows Netzwerk6 Kommentare

Guten Abend, ich war neulich mit unserem Admin am Tisch gesessen. Er an seinem Notebook angemeldet mit dem Domänen-Admin, ...