AW: Hier ein Code
16.06.2017 20:32:27
Max2
Hallo,
hier ein Code der dir die Daten ins Sheet schreibt:
Option Explicit
Private Function getName(ByVal str As String) As String
Dim i As Integer
i = Len(str)
If Left(str, 2) = "TN" Then
str = Mid(str, 3, i - 2)
str = LTrim(str)
ElseIf Left(str, 3) = "Mod" Then
str = Mid(str, 4, i - 3)
str = LTrim(str)
End If
getName = str
End Function
Private Sub IntoSheet(ByVal ws As Worksheet, _
arrNamen() As String, _
arrDaten() As Long)
Dim i As Integer, j As Integer
Dim ref As String
With ws
i = 2
Do
ref = .Cells(i, 2).Value
ref = getName(ref)
For j = 0 To UBound(arrNamen)
If arrNamen(j) = ref Then
.Cells(i, 3).Value = arrDaten(j)
Exit For
End If
Next j
i = i + 1
Loop Until i = 10
End With
End Sub
Sub countValues()
Dim ws As Worksheet
Dim cRow As Long, counter As Long
Dim i As Long, j As Long, ii As Long
Dim temp As String
Dim arrNamen() As String, arrCounter() As Long
Set ws = ThisWorkbook.Sheets(1)
With ws
cRow = .Cells(.Rows.Count, 1).End(xlUp).Row
i = cRow
Do Until i = 1
temp = .Cells(cRow, 1).Value
For j = 4 To cRow
If .Cells(j, 1).Value = temp Then
counter = counter + 1
.Cells(j, 1).Value = ""
End If
Next j
ReDim Preserve arrNamen(ii)
ReDim Preserve arrCounter(ii)
arrNamen(ii) = temp
arrCounter(ii) = counter
ii = ii + 1
cRow = .Cells(.Rows.Count, 1).End(xlUp).Row
counter = 0
i = cRow
Loop
End With
IntoSheet ws, arrNamen, arrCounter
End Sub
Bei deinem Code sind, soweit ich das sehen kann, die "Ketten" Falsch.
Mit Ketten, hast du einen Counter aber du verwendest Ketten auch als Index.
Ich habe den Code aber nur kurz überflogen.
Leider muss gestehen... das ich mir ungern ewig lang fremden Code anschaue, der nach kurzer Zeit abbricht.
Den Code selbst oder anders zu schreiben, geht meistens schneller bei mir.
Wo ist überhaupt der Sinn bei der Kategorien Zahl?
Für mich wirkt das zusammenhangslos und willkürlich.
Kannst du mir das Bitte erklären.