Supportnet Computer Supportnet Games Supportnet Kochen Explipedia
Login: guestBesucher online: 362
Supportnet Computerforum
SUPPORT
Home
Forum
Tipps & Infos
Blitz Angebote
Members
Hilfe
Video

TOP THEMEN
SSD Test
Alles über SSDs

Android Tipps
iPad Tipps
Google Tipps
Windows 8 FAQ
Windows 7 FAQ
E-Mail FAQ
Netzwerk FAQ
Festplatten FAQ
Datenrettung FAQ
Bildbearbeitung FAQ

Top iPhone Apps
Computer Einsteiger
Die 5 besten...
Explipedia
Themen
Direktlinks

Neue Einträge
News einsenden News einschicken
Tipps einsenden Tipp einschicken

SN-LINKS

Suche
Befreundete Seiten
Top Seiten

Supportnet/Forum/Tabellenkalkulation



Supportnet/Forum/Tabellenkalkulation
von Ellea19 vom 09.08.2017, 22:42 Diese Seite den Supportnet Favoriten hinzufügen  Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden


Frage an M.O bezüglich Makro

 (177 Hits)

Hallo M.O

du hast mir mal dieses Makro geschrieben,
es sucht nach Zahlen und fügt sie in eine neue Tabelle.
Das Makro läuft einwandfrei.

Sub Arraysuchen()

Dim wksBlatt1 As Worksheet
Dim wksBlatt2 As Worksheet
Dim wksBlatt3 As Worksheet
Dim lngLetzte As Long
Dim lngLetzte3 As Long
Dim lngSpalte As Long
Dim lngSpalteL As Long
Dim varSuchen As Variant
Dim varSpalte As Variant
Dim lngZaehler As Long
Dim s As Long
Dim a As Long
Dim e As Long
Dim lngAnfang As Long
Dim lngEnde As Long
Dim lngFarbe As Long
Dim lngZeile As Long
Dim lngEinleseS As Long
Dim lngDurchlauf As Long
Dim lngd As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Arbeitsblätter festlegen
Set wksBlatt1 = ThisWorkbook.Worksheets("Archiv-Zahlen") 'Tabelle, die durchsucht werden soll
Set wksBlatt2 = ThisWorkbook.Worksheets("Such->Zahlen") 'Tabelle mit den zu suchenden Zahlen
Set wksBlatt3 = ThisWorkbook.Worksheets("Gefundene Zahlen") 'Tabelle in die die Suchergebnisse einfügt werden

'Suchzahlen aus Arbeitsblatt Suchartikel in Array einlesen
'dazu die letzte Zeile im Arbeitsblatt in Spalte A ermitteln
With wksBlatt2
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
'nun ab A1 die Daten in das Sucharray einlesen
varSuchen = .Range(.Cells(1, 1), .Cells(lngLetzte, 1))
End With

'in Zieltabelle für Suchergebnisse ggf. vorhandene Daten löschen
wksBlatt3.Cells.Clear

'Im Suchblatt letzte Spalte ermitteln
lngSpalteL = wksBlatt1.Cells(1, Columns.Count).End(xlToLeft).Column

'Anzahl der Spalten festlegen, die pro Durchlauf eingelesen werden sollen
lngEinleseS = 1

'Anzahl der Durchläufe ermitteln
'Ganzzahl der Durchläufe ermitteln
lngDurchlauf = Int(lngSpalteL / lngEinleseS)
'Prüfen, ob Durchlauf ggf. um 1 erhöht werden muss
If lngSpalteL Mod lngEinleseS > 0 Then lngDurchlauf = lngDurchlauf + 1

'letzte Zeile ermitteln
lngLetzte = wksBlatt1.Cells.SpecialCells(xlCellTypeLastCell).Row

'Schleife, um alle Spalten im Suchblatt zu durchlaufen
For lngd = 0 To lngDurchlauf - 1

With wksBlatt1
'Spalten in Array einlesen
varSpalte = .Range(.Cells(1, 1 + lngd * lngEinleseS), .Cells(lngLetzte, lngEinleseS + lngEinleseS * lngd))
End With

'Vergleich
For lngSpalte = LBound(varSpalte, 2) To UBound(varSpalte, 2)
'Statusmeldung
Application.StatusBar = "Spalte " & lngSpalte + lngd * lngEinleseS & " von " & lngSpalteL & " wird durchsucht "

For a = LBound(varSpalte, 1) To UBound(varSpalte, 1)
'Zaehler auf Null setzen
lngZaehler = 0
For s = LBound(varSuchen, 1) To UBound(varSuchen, 1)
'Prüfen, ob zu vergleichendes Element im Array varSpalte existiert
If a + s - 1 <= UBound(varSpalte, 1) Then
'falls ja, dann vergleichen
If varSpalte(a + s - 1, lngSpalte) = varSuchen(s, 1) Or varSuchen(s, 1) = "*" Then
lngZaehler = lngZaehler + 1
Else
Exit For
End If
End If
Next s

'Falls Übereinstimmung,
If lngZaehler = UBound(varSuchen, 1) Then

'dann Anfang und Ende des einzufügenden Bereichs festlegen
lngAnfang = a - 5
lngEnde = a + UBound(varSuchen, 1) + 4
'Anfang und Ende prüfen, ob diese im zulässigen Bereich liegen
If lngAnfang < 1 Then lngAnfang = 1
If lngEnde > UBound(varSpalte, 1) Then lngEnde = UBound(varSpalte, 1)
'Zeile für das Einfärben der gefundenen Übereinstimmungen ermitteln
lngFarbe = a - lngAnfang

'letzte Zeile in Einfügespalte = Suchspalte ermitteln
lngLetzte3 = wksBlatt3.Cells(Rows.Count, lngSpalte + lngEinleseS * lngd).End(xlUp).Row + 2
'Einfügezeile ggf. korrigieren
If lngLetzte3 = 3 Then lngLetzte3 = 1
'Inhalte einfügen
With wksBlatt3
'Zähler für Einfügezeile auf Null setzen
lngZeile = 0
For e = lngAnfang To lngEnde
.Cells(lngLetzte3 + lngZeile, lngSpalte + lngEinleseS * lngd) = varSpalte(e, 1)
lngZeile = lngZeile + 1
Next e
End With

'Suchzahlen in gefundener Reihe einfärben
With wksBlatt3
.Range(.Cells(lngLetzte3 + lngFarbe, lngSpalte + lngEinleseS * lngd), .Cells(lngLetzte3 + lngFarbe + UBound(varSuchen, 1) - 1, lngSpalte + lngEinleseS * lngd)).Interior.ColorIndex = 28
End With
End If

Next a

Next lngSpalte
Next lngd

'Auf Blatt 3 mit den gefundenen Daten wechseln
With wksBlatt3
.Activate
.Range("A1").Select
End With


'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Nun meine Frage gebe es eine Möglichkeit mehrere Zahlen gleichzeitig zu suchen?

Also z.b anstatt
45
8
18

soll er

45
8,9,10
17,18

suchen in jeder Möglichen Konstellation aber richtigen Reihenfolge.
Immo ist es so, das ich das seperat suchen muss.

K.A ob das so machbar wäre.
Vielleicht mit Variablen die man den Zahlen vorher zuweist oder so.

Über eine Antwort würde ich mich freuen wie auch immer die aussieht.

lg
Ellea19


Antwort schreiben 50 Bonuspunkte

Antworten...
Antwort 1 von M.O. vom 10.08.2017, 09:17 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Ellea,

was meinst du genau mit
Zitat:
suchen in jeder Möglichen Konstellation aber richtigen Reihenfolge.


Soll er bei deinem Beispiel
45
8,9,10
17,18

also u.a.
45 - 8 - 17
45 - 9 - 17
45 - 9 - 18
45 -10 - 17

finden?

Das ist grundsätzlich machbar.

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Diese Antwort hat mein Problem gelöst
Antwort 2 von Ellea19 vom 10.08.2017, 12:53 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hi M.O

ja genau so meinte ich das, also jede Mögliche Zahlenkombination

45 - 8 - 17
45 - 8 - 18
45 - 9 - 17
45 - 9 - 18
45 -10 - 17
45 -10 - 18


Lg
Ellea


Antwort noch nicht bewertet




Antwort schreiben
    Bitte einen 'Nickname' wählen.
Nickname:*
    (eMail-Adresse wird nicht veröffentlicht.)
eMail:
Nachricht: Ich möchte bei Antworten benachrichtigt werden.
    Hilfe zur Beitragsformatierung gibts [hier]
                   
Antwort:*
  Die Nutzungsbedingungen habe ich gelesen und akzeptiert.

MACHEN SIE IHRE WEBSITE ATTRAKTIVER
Sie haben eine eigene Website und wollen Ihre Besucher auf den Supportnet-Service aufmerksam machen? Kopieren Sie einfach den Quellcode in Ihre Seite und jeder Besucher Ihrer Seite kann direkt auf die Supportnet-Datenbank zugreifen.

My Supportnet


SUCHE

Gruppen im Forum
Betriebsysteme
Software
Hardware
Netzwerk
Programmierung
Sonstiges

Impressum © 1997-2015 SupportNet
Version: supportware 1.8.230E / 18.10.2010, Startzeit:Tue Oct 17 18:17:53 2017