2xVerlinkung und Appl.Match
12.02.2021 12:45:26
Matthias
ich habe mich das letzte Monat recht intensiv mit Excel VBA beschäftigt / mir versucht ansatzweise beizubringen und stehe nun jedoch an:
Situation:
- Mehrere Tabellenblätter, die jeweils einen Mitarbeiter darstellen (wks1, wks2, wks3,..., wksN)
- in Spalte 2 (B), Zeile 27 aller Worksheets sind Laufnummern (1,2,3,4,5,6,..,n) gelistet. (Hintergrund: Jedes Projekt hat eine Nr.)
- Diese Laufnummer KANN jedoch doppelt vorkommen (also zB in wks1 und in wks3 steht dann in Spalte B "2", die Zeilennr ist jedoch meist unterschiedlich). (Hintergrund: ein und dasselbe Projekt kann von zwei Mitarbeitern gleichzeitig bearbeitet werden)
Wunsch (zb auf wks1 bezogen):
- Nummern in wks1/Spalte 2/ab Zeile 27 mit Nummern der restlichen wks (Spalte 2/Zeile 27) vergleichen und WENN ein Match vorkommt dann soll mir der Code die Zellen daneben entsprechend in beide Richtungen verlinken.
Das ganze passiert, sobald ich bei Mitarbeiter X die entsprechenden Projektdaten eingegeben habe und auf einen Makrobutton "Übermitteln" klicke. Die entsprechenden Daten werden dann in die Zellen des Projektbuddys eingetragen.
Der Code dazu ist untenstehend, die Verlinkung funktioniert aber nur in eine Richtung (Code ist _
in einem Modul, vmtl. müsste ich ihn aber in die entsprechenden Private Subs der Worksheets _
eintragen mit "
Private Sub Worksheet Change(ByVal Target As Range)) ?
Code
Sub MA1ProjektUebermitteln()
'Variablen definieren
Dim iClick As Integer
freiezeileMA1 As Long, freiezeileMAx As Long
Dim wksMA1 As Worksheet
Dim iIndex As Integer
Set wksMA1 = ThisWorkbook.Sheets("MA1")
freiezeileMA1 = wksMA1.Cells(1048576, 2).End(xlUp).Row
If Cells(freiezeileMA1, 6).Value > 0 And Cells(freiezeileMA1, 7).Value > 0 Then
iClick = MsgBox( _
prompt:="Verantwortlichkeit und Buddy wurden ausgewählt, übermitteln?", _
Buttons:=vbYesNo)
If iClick = vbYes Then
MsgBox (wksMA1.Name & "!" & Cells(freiezeileMA1, 2).Address)
n = Worksheets.Count
For iIndex = 1 To n
If Worksheets(iIndex).Name = Cells(freiezeileMA1, 6).Value Then
freiezeileMAx = Worksheets(iIndex).Cells(1048576, 2).End(xlUp).Row + 1
Worksheets(iIndex).Cells(freiezeileMAx, 2) = "=" & wksMA1.Name & "!" & _
_
_
_
Cells(freiezeileMA1, 2).Address 'Laufnummer
Worksheets(iIndex).Cells(freiezeileMAx, 3) = "=" & wksMA1.Name & "!" & _
_
_
_
Cells(freiezeileMA1, 3).Address 'Titel
Worksheets(iIndex).Cells(freiezeileMAx, 8) = "=" &wksMA1.Name & "!" & _
_
_
_
Cells(freiezeileMA1, 8).Address 'Betriebsstätte
Worksheets(iIndex).Cells(freiezeileMAx, 10) = "=" & wksMA1.Name & "!" & _
_
_
_
Cells(freiezeileMA1, 10).Address 'Anfang Datum
Worksheets(iIndex).Cells(freiezeileMAx, 11) = "=" & wksMA1.Name & "!" & _
_
_
_
Cells(freiezeileMA1, 11).Address 'Ende Datum
Worksheets(iIndex).Cells(freiezeileMAx, 6).Value = wksMA1.Name
If Cells(freiezeileMA1, 7).Value = "Hauptverantwortlich" Then
Worksheets(iIndex).Cells(freiezeileMAx, 7).Value = "Buddy"
ElseIf Cells(freiezeileMA1, 7).Value = "Buddy" Then
Worksheets(iIndex).Cells(freiezeileMAx, 7).Value = " _
Hauptverantwortlich"
End If
End If
Next iIndex
MsgBox ("Projektnummer, Verantwortlichkeit und Buddy wurden übermittelt")
ElseIf iCklick = vbNo Then
Exit Sub
End If
ElseIf Cells(freiezeileMA1, 6).Value = 0 Or Cells(freiezeileMA1, 7) = 0 Then
MsgBox ("Verantwortlichkeit und Buddy wurden noch nicht eingetragen")
Exit Sub
End If
End Sub