Auflisten VBA

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

AW: Auflisten VBA

12.02.2016 21:38:05

Raphael
AW: Auflisten VBA

18.02.2016 11:40:34

eric

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

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)

Forumthread: Auflisten VBA

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread