Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1608to1612
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
Spalte auswerten und neue Tabelle anlegen
15.02.2018 11:40:05
Geronimus
Hallo liebes Forum,
meine VBA-Probleme werden immer größer.
Ist es möglich, die Anzahl eines Wertes in einer Spalte auszulesen und diesen Wert dann in eine neue Tabelle einzutragen? Das Problem ist, dass in der Spaltem, die ausgelesen werden soll, um die 200 Werte stehen. Ich habe eine Suchmaske, mit der ich das händisch machen kann, aber da werd ich ja bis Weihnachten nicht fertig.
Bisher sieht mein Code so aus:
Sub Suchen()
Dim strSuchbegriff As String
Dim lngTreffer As Long
strSuchbegriff = InputBox("Geben Sie einen Suchbegriff ein:", _
"Durchsucht Spalte Datum")
lngTreffer = Application.WorksheetFunction.CountIf(Columns(6), strSuchbegriff)
MsgBox lngTreffer & " mal " & strSuchbegriff, , ""
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte auswerten und neue Tabelle anlegen
15.02.2018 14:26:03
chao.soft
Hey Geronimus,
wenn ich das richtig verstehe, dann hast du eine Tabelle mit ganz vielen Daten, wo in Spalte 6 immer ein Datum steht. Jetzt möchtest du diese Daten nach einem bestimmten Datum durchsuchen und alle gefundenen Ergebnisse in ein neues Tabellenblatt kopieren. Hab ich das so richtig verstanden?
Versuch es mal mit folgendem Code. Wahrscheinlich musst du die Adressen etwas anpassen, da ich nicht weiß wie genau deine Tabelle aufgebaut ist.

Sub KopiereNachDatum()
Dim strSuchbegriff As String
Dim lngTreffer As Long
strSuchbegriff = InputBox("Geben Sie einen Suchbegriff ein:", _
"Durchsucht Spalte Datum")
lngTreffer = Application.WorksheetFunction.CountIf(Columns(6), CDate(strSuchbegriff))
MsgBox lngTreffer & " mal " & strSuchbegriff, , ""
'NEU
If lngTreffer > 0 Then
If IsError(Evaluate(strSuchbegriff & "!A1")) Then
'Wenn Tabelle noch nicht vorhanden, dann erstellen
ThisWorkbook.Worksheets.Add.Name = strSuchbegriff
End If
Dim intLastRow, i, j As Long: j = 1
'letzte Zeile der Daten herausfinden
intLastRow = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
'alle Zeilen der Daten durchlaufen
For i = 1 To intLastRow
'Wenn Datum mit Suchbegriff übereinstimmt...
If strSuchbegriff = Tabelle1.Cells(i, "F") Then
'...dann die Zeile in die (neue) Tabelle übernehmen
Tabelle1.Rows(i).EntireRow.Copy ThisWorkbook.Worksheets(strSuchbegriff).Rows(j)
j = j + 1
End If
Next
'(neue) Tabelle mit den gesuchten Daten anzeigen
ThisWorkbook.Worksheets(strSuchbegriff).Select
End If
End Sub
Beste Grüße
chaosoft
Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige