Live-Forum - Die aktuellen Beiträge
Datum
Titel
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
25.04.2024 08:41:49
VBA: Probleme mit pdftk zum Zusammenfügen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1472to1476
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
1472to1476
1472to1476
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Auflisten VBA

Auflisten VBA
12.02.2016 10:21:51
eric
Hallo liebe alle,
ich habe mit dem folgenden Makro zum Auflisten 2 Probleme, die ich selbst nicht lösen kann. Am besten einfach mal ausprobieren, ich habs hier angehängt:
https://www.herber.de/bbs/user/103489.xlsm
1. Treten Dopplungen auf und
2. Hapert es mit Findings bei .5 eines jeden Kapitels (weil oft mehr als zwei Zeilen)
Kann jemand helfen? oder hat eine ganz andere Idee für die Umsetzung?
Tausend Dank und beste Grüße
Eric

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auflisten VBA
12.02.2016 21:38:05
Raphael
Hallo Eric,
du könntest folgenden Code versuchen.
Allerdings sind in deiner Mappe diverse Formeln und anderes unter den Tabellen aufgeführt. Wenn du daran etwas änderst, kann es sein das der Code nicht mehr funktioniert. Liegt am finden der letzten Zeile mit Eintrag. Aber wenns so bleibt wies ist, dann geht der. 

Sub suchen()
Dim i, j, k, l
Dim sh As Worksheet
Dim shS As Worksheet
Dim lzeile As Long
Dim lzS As Long
Set shS = Sheets("LIST OF FINDINGS")
For Each sh In Worksheets
If Not sh.Name = "FINDINGS CLARIFICATION" And _
Not sh.Name = "SUMMARY" And _
Not sh.Name = "LIST OF FINDINGS" Then
lzeile = sh.Cells(Rows.Count, 13).End(xlUp).Row - 2 ' da in letzter Zeile ungültige  _
Formel
If lzeile > 4 Then 'prüfen ob ein Eintrag vorhanden ist
For i = 4 To lzeile
If sh.Cells(i, 13)  "" Then
lzS = shS.Cells(Rows.Count, 2).End(xlUp).Row + 1 'Zeile in die der  _
Eintrag geschrieben wird
'Werte übertragen
With shS
.Cells(lzS, 2) = sh.Cells(FindChapter(sh, i, 2), 2)
.Cells(lzS, 3) = sh.Cells(2, 4)
.Cells(lzS, 4) = sh.Cells(i, 13)
.Cells(lzS, 5) = sh.Cells(FindChapter(sh, i, 4), 4)
End With
End If
Next i
End If
End If
Next sh
End Sub
Function FindChapter(ByRef sh As Worksheet, _
ByVal Startzeile As Long, _
ByVal Spalte As Long) As Long
Dim i As Long
For i = Startzeile To 3 Step -1
If sh.Cells(i, 2)  "" Then
FindChapter = i
Exit Function
End If
Next i
End Function
Gruess
Raphael

Anzeige
AW: Auflisten VBA
18.02.2016 11:40:34
eric
Hallo Raphael,
wirklich vielen vielen Dank für Deine Hilfe. Ein paar Anpassungen muss ich jetzt noch machen, aber ich hoffe ich bekomme die hin (z.B. muss eine Spalte noch dazu ausgelesen werden - Description of Finding). Hammer, bin wirklich happy mit dem Tool jetzt.
Beste Grüße.
Eric

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige