Spalte auswerten und neue Tabelle anlegen

Forumthread: 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

AW: Spalte auswerten und neue Tabelle anlegen

15.02.2018 14:26:03

chao.soft

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

Beliebteste Forumthreads (12 Monate)

Spalte auswerten und neue Tabelle anlegen

Forumthread: Spalte auswerten und neue Tabelle anlegen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread