23.06.2018, 20:51
Hallo Leute,
Habe folgende Herausforderung an euch.
habe eine Tabelle erstellt, in der ich gerne sehen möchte wer zu der Schicht Dienst gemacht hat.
In Spalte B bis ende stehen die Namen ab Zeile B5. In den Spalten C3 bis K3 wo nach gesucht werden soll.
Hab schon ein bischen Code. Der Code findet schon alle Spalten die in C3 Bis K3 stehen.
Jetzt möchte ich das der Code alle beschriebenen zellen findet und in den Cellen C3 Bis K3 mir einträgt wie oft dies vorkommt.
Bsp.:
Suche Nach Vorstand
Gefunden in L3
jetzt sollen die einträge bei den zugehörigen Namen addiert werden. Ich möchte am ende eine Zahl haben wie oft
Usw.:
Das habe ich bis jetzt an Code, er findet die Spalten
Ich brauche jezt den Mittelteil zum eintragen in den Spalten C-K
Habe folgende Herausforderung an euch.
habe eine Tabelle erstellt, in der ich gerne sehen möchte wer zu der Schicht Dienst gemacht hat.
In Spalte B bis ende stehen die Namen ab Zeile B5. In den Spalten C3 bis K3 wo nach gesucht werden soll.
Hab schon ein bischen Code. Der Code findet schon alle Spalten die in C3 Bis K3 stehen.
Jetzt möchte ich das der Code alle beschriebenen zellen findet und in den Cellen C3 Bis K3 mir einträgt wie oft dies vorkommt.
Bsp.:
Suche Nach Vorstand
Gefunden in L3
jetzt sollen die einträge bei den zugehörigen Namen addiert werden. Ich möchte am ende eine Zahl haben wie oft
Usw.:
Das habe ich bis jetzt an Code, er findet die Spalten
Code:
Sub Refres()
Dim intAnz As Integer
Dim intZeile As Integer
Dim intSpalte As Integer
Dim varDatArr(39, 8) As Variant
Dim intArbBl As Integer
Dim varBlArr As Variant
varBlArr = Array("Tabelle1")
lngSpa = Cells(3, Columns.Count).End(xlToLeft).Column
lngZei = Cells(Rows.Count, 2).End(xlUp).Row
For intArbBl = 1 To 1
For intZeile = 3 To 3 'Zeilen vorgabe
For intSpalte = 3 To 11 'Bereich zum suchen
'!!!!!!Diese Zeile muss auch noch geändert werden ab C3 bis letzte beschriebene Zeile!!!!!!
With Sheets(varBlArr(intArbBl - 1)).Range("C3:CU3")
'########################################################################
Set c = .Find(Tabelle1.Cells(intZeile, intSpalte), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'###################################################################################################################################
'Hier sollte der Code für den Eintrag in Zeilen und Spalten für den jewiligen Namen stehen!
'Ab C5 bis letzte beschrieben Spalte
'#############Aus alten Code#########
' If c.Row Mod 4 = 2 Then
' intAnz = c.Column - 2
' varDatArr(intZeile - 5, intAnz) = varDatArr(intZeile - 5, intAnz) + 1
' End If
'#######################################################################################################################################
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next intSpalte
Next intZeile
Next intArbBl
'In Tabelle1.Range("C5:K44") die ertmittelten Werte eintragen
Tabelle1.Range("C5:K41") = varDatArr
Set c = Nothing
'Stop
End Sub
mfg
Michael
:98:
WIN 10 Office 2019
Michael
:98:
WIN 10 Office 2019