Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
25.04.2024 09:23:47
Spalten in Kreuztabelle hinzufügen/löschen je nach Vorgabe
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro für Listenabfrage !

Makro für Listenabfrage !
20.06.2008 07:54:00
Ernst
Guten Morgen !
Ich habe folgende Problemstellung und zwar in meiner Liste die unter
folgendem Link ersichtlich ist: https://www.herber.de/bbs/user/53219.xls
gibt es eine Abfrage Zelle in der ich eine Nr. eingebe worauf die Spalten A4-A101/E4-E101/I4-I101 auf Treffer überprüft werden sollten ,die Trefferzellen sollten farblich zb.gelb markiert werden weiters gibt es eine Ausgabezelle in der di Anzahl der Treffer ersichtlich sein sollten. Bei Speicherung der Tabelle sollten die Farbmarkierungen sowie die Eingabe und Ausgabezelle wieder auf ihren Ursprung zurück gesetzt werden.
Wäre für Lösungsvorschlag sehr dankbar.
Lg.Ernst

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro für Listenabfrage !
20.06.2008 09:33:00
Herbert
Hallo Ernst!
in etwa so:
'Standardmodul
Sub zählen()
Dim arrTab, i%, s%, x%, lz%
With Sheets("Auslaufmanagement")
lz = .Cells(Rows.Count, 2).End(xlUp).Row
arrTab = .Range("a4:i" & lz)
For i = 1 To UBound(arrTab, 1)
For s = 1 To UBound(arrTab, 2)
If arrTab(i, s) = .Range("e2").Value Then
x = x + 1
.Cells(i + 3, s).Interior.ColorIndex = 6
End If
Next
Next
.Range("f2").Value = x
End With
End Sub


' "Diese Arbeitsmappe"


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
With Sheets("Auslaufmanagement")
lz = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("a4:a" & lz).Interior.ColorIndex = xlNone
.Range("e4:e" & lz).Interior.ColorIndex = xlNone
.Range("i4:i" & lz).Interior.ColorIndex = xlNone
.Range("e2").ClearContents
.Range("f2").ClearContents
End With
End Sub


' "Auslaufmanagement"


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("e2")) Is Nothing And ActiveCell.Value > 0 Then Call zählen
End Sub


in meinem Beispiel ist die Eingabezelle "e2" !
Grüße Herbert

Anzeige
AW: Makro für Listenabfrage !
20.06.2008 10:05:34
Ernst
Hey !
Danke für den raschen Lösungsvorschlag funktioniert einwandfrei allerdings wäre es von Vorteil wenn bei erneuter suchabfrage die Bestehenden Markierten Felder auf ihren Ursprung zurückgesetzt werden, da ansonsten der Überblick verloren geht ist das machbar ?
lg.Ernst

AW: Makro für Listenabfrage !
20.06.2008 10:28:00
Herbert
du brauchst doch nur die drei Codezeilen von "Before_Save" reinkopieren...

Sub zählen()
Dim arrTab, i%, s%, x%, lz%
With Sheets("Auslaufmanagement")
lz = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("a4:a" & lz).Interior.ColorIndex = xlNone
.Range("e4:e" & lz).Interior.ColorIndex = xlNone
.Range("i4:i" & lz).Interior.ColorIndex = xlNone
arrTab = .Range("a4:i" & lz)
For i = 1 To UBound(arrTab, 1)
For s = 1 To UBound(arrTab, 2)
If arrTab(i, s) = .Range("e2").Value Then
x = x + 1
.Cells(i + 3, s).Interior.ColorIndex = 6
End If
Next
Next
.Range("f2").Value = x
End With
End Sub


Grüße Herbert

Anzeige
AW: Makro für Listenabfrage !
20.06.2008 10:15:00
fcs
Hallo Ernst,
1. Markierung der Treffer
Hierfür solltest eine bedingte Formatierung verwenden:

Formel für A4: =WENN(UND(NICHT(ISTLEER(A4));A4=$D$2);WAHR;FALSCH)


Dieses Format kann auf die anderen Zellen in den 3 Spalten übertragen werden
2. Zählen der Treffer
Zelle F2:


Formel:=ZÄHLENWENN(A4:A101;D2)+ZÄHLENWENN(E4:E101;D2)+ZÄHLENWENN(H4:H101;D2)


Benutzerfediniertes Format: 0" x";;
3. Zurücksetzen der Anzeige (Löschen des Eintrags in Zelle D2
Anpassen der Prozedur zurück


Sub zurück()
' zurück Makro
' Makro am 02.11.2006 von Ernst aufgezeichnet
Range("D2").ClearContents
ActiveWorkbook.Close SaveChanges:=True
End Sub


Gruß
Franz

Anzeige
Danke !
20.06.2008 10:42:00
Ernst
Hallo VBA Profis !
Das funktioniert einwandfrei....recht herzlichen Dank und schönen Tag noch !
Lg.Ernst

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige