Rätsel bei Transpose
18.11.2013 08:34:40
Gregor
Ich benutze folgenden Code:
Sub Shape()
Dim n As Double
Dim Zähler As Double
Dim arrFind()
Dim rZelle As Range
Dim sFundst As String
Zähler = 0
Wert = ActiveSheet.Shapes(Application.Caller).Name
With Worksheets("Muster")
Set rZelle = .Columns(1).Find(What:="Linie", LookAt:=xlPart, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
If .Cells(rZelle.Row, 12).Value Like "*" & Wert & "*" Then
n = n + 1
ReDim Preserve arrFind(1 To 5, 1 To n)
arrFind(1, n) = "*) " & .Cells(rZelle.Row, 12)
arrFind(2, n) = .Cells(rZelle.Row, 3)
arrFind(3, n) = .Cells(rZelle.Row, 13)
arrFind(4, n) = .Cells(rZelle.Row, 14)
arrFind(5, n) = .Cells(rZelle.Row, 15)
Zähler = Zähler + 1
End If
Set rZelle = .Columns(1).FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
End If
If n = 0 And Zähler = 0 Then
MsgBox Prompt:="Keine Einträge gefunden" _
& vbNewLine & vbNewLine, _
Title:=" Mitteilung an " & Application.UserName
End
End If
End With
With usrSuchen_Projekt.lstFind
.ColumnCount = 5
.List = Application.Transpose(arrFind)
End With
usrSuchen_Projekt.Show
Erase arrFind
End Sub
Der primäre Suchbegriff "Linie" in Spalte 1 kommt mehrmals vor. Bei gewissen variablen Begriffe "Wert" werden die gefundenen Einträge in Spalte 12 in der Liste usrSuchen_Projekt.lstFind mit Application.Transpose(arrFind) korrekt aufgelistet, bei anderen nicht. Der Grund, weshalb bei gewissen "Werte" die eingelesenen Einträge nicht aufgelistet werden, das heisst die Liste vollständig leer bleibt, ist mir ein Rätsel. Bei der Abfrage in Einzelschritten fällt mir auf, dass arrFind immer richtig eingelesen, aber mit Application.Transpose(arrFind) nicht übertragen wird. Entweder wird alles korrekt aufgelistet oder die Liste bleibt vollständig leer (je nach Wert immer das gleiche Verhalten).Woran kann das liegen und wie kann ich das richtigstellen?
Vielen Dank und Gruss
Gregor