AW: Top:: owT
10.12.2014 01:22:40
Mullit
Hallo Ralph,
das reicht leider von erschreckend schwach bis absolut tödlicher Fehler; die Long-Vars sind Killer...
ich bleibe optimistisch ;-)
Aber das ehrt Dich: es fehlte die Initialisierung von ialngRow = 0:
Option Explicit
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long
Public Sub test()
Const START_COLUMN As Long = 2
Const SEARCH_STRING As String = "XX_"
Dim wksSheet As Worksheet
Dim objRange As Range
Dim avntArray As Variant
Dim avntOutput() As Variant
Dim vntElem As Variant
Dim strName As String
Dim ialngRow As Long, ialngColumn As Long
Dim lngRow As Long
Application.ScreenUpdating = False
With Worksheets("Main")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row
avntArray = .Cells(2, 1).Resize(lngRow, 1)
For Each wksSheet In Worksheets
With wksSheet
If Left$(String:=.Name, Length:=Len(SEARCH_STRING)) = SEARCH_STRING Then
ialngColumn = ialngColumn + 1
Redim Preserve avntOutput(lngRow, ialngColumn - 1) As Variant
strName = Mid$(String:=.Name, Start:=Len(SEARCH_STRING) + 1)
avntOutput(0, ialngColumn - 1) = strName
Set objRange = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
ialngRow = 0
For Each vntElem In avntArray
ialngRow = ialngRow + 1
If Not IsError(Application.Match(vntElem, objRange, 0)) Then
avntOutput(ialngRow, ialngColumn - 1) = strName
Else
avntOutput(ialngRow, ialngColumn - 1) = vbNullString
End If
Next
End If
End With
Next
If CBool(SafeArrayGetDim(avntOutput)) Then
.Cells(1, START_COLUMN).Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
.Cells(1, START_COLUMN).Resize(1, ialngColumn).Font.Bold = True
.Cells(1, START_COLUMN).Resize(ialngRow + 1, ialngColumn) = avntOutput
Set objRange = Nothing
Else
MsgBox "Keine TabBlätter mit " & "'" & SEARCH_STRING & _
"'" & " im Namen vorhanden!", vbExclamation
End If
End With
Application.ScreenUpdating = True
End Sub
Public Sub ctrltest()
With Worksheets("Main")
MsgBox WorksheetFunction.CountIf(.Cells(2, 2).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1), "T123") _
& vbCr & vbCr & "Hopefully 1264...;-)"
End With
End Sub
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 12
Versuchen wir beide optimistisch zu bleiben und schmeiß bei der Gelegenheit die Test-Sub ctrltest an, ob jedesmal die Werte stimmen...
Gruß, Mullit