Thema Datum  Von Nutzer Rating
Antwort
Rot werte aus drei Tabellen...suchen, vergleichen und eintragen
13.12.2017 15:04:19 Søren
NotSolved
14.12.2017 07:49:21 Søren
Solved

Ansicht des Beitrags:
Von:
Søren
Datum:
13.12.2017 15:04:19
Views:
824
Rating: Antwort:
  Ja
Thema:
werte aus drei Tabellen...suchen, vergleichen und eintragen

Hallo liebes VBA Team,

ich versuche seit Tagen ein Problem in meinem Programm zu beheben, aber irgendwie.....na ja....fehlt mir der Durchblick.... :-(

Folgende Situation:

ich habe ein tabellenblatt mit dem namen "einsatzplan". Dort klicke ich in zellen der spalte 2 damit sich eine userform "auswahl" öffnet.

dort stehen verschiedene namen von mitarbeitern drin, welche sich vba aus der tabelle mitarbeiter holt. man kann dann einen mitarbeiter

auswählen und vba trägt diesen namen dann in die tabelle "einsatzplan"....das ganze passiert dann auch noch mit den fahrzeugen und so weiter.

Wenn mehrere mitarbeiter für ein projekt ausgewählt werden, kann man sich auch noch einen verantwortlichen aussuchen, der im internen Auftrag dann auch als verantwortlicher mitarbeiter eingetragen wird.

wenn alles eingetragen ist, erstellt ein makro anhand dieser daten einen internen auftrag in das tabellenblatt "interner Auftrag".

Funktioniert alles wunderbar.....nur möchte ich gern, das die adresse von diesem mitarbeiter im internen auftrag erscheint, sagen wir mal in zeile 45 spalte 3.

Die Adresse steht in der tabelle "mitarbeiter" in spalte 2, immer neben dem jeweiligen Mitarbeiter.

das makro müsste quasi während des erstellens des internen auftrages schauen, wer der verantwortliche mitarbeiter ist, dann in der tabelle mitarbeiter diesen suchen und aus der spalte zwei dann die adresse des mitarbeiters in den internen auftrag eintragen....

ich hoffe, es ist einigermaßen verständlich erklärt...der Code, der den internen auftrag erstell, füge ich hinzu....

würde mich freuen wenn mich jemand versteht....;-)

 


Sub Schaltfläche10_Internen_Auftrag_erstellen()
Dim lrow As Long
Dim lzeile As Long
Dim vntin As Variant
Dim vntPers As Variant
Dim i%, j  As Integer
Dim dteStart As Date
Dim dteEnde As Date
Dim blnstart As Boolean

vntPers = Cells(ActiveCell.Row, 1).Resize(, 26).Value
lzeile = Fix((ActiveCell.Row - 10) / 38) * 38 + 7

i = 6

While i < 26
    If Len(vntPers(1, i)) > 0 Then
      If Not blnstart Then
         dteStart = Cells(lzeile, i)
         j = i
         blnstart = True
      End If
      dteEnde = Cells(lzeile, i)
     
    End If
     i = i + 3
Wend

With Worksheets("Projektübersicht")
   
   lrow = WorksheetFunction.Match(Cells(ActiveCell.Row, 1), .Columns(1), 0)
   vntin = .Cells(lrow, 1).Resize(, 46).Value

End With
i = CInt(InputBox("bitte Nr. des Verantwortlichen eingeben " & vbLf & "oberster Eintrag = 1 usw ", "Verantwortung übernimmt Nr...", 1))

With Sheets("Interner Auftrag")
' trägt die Daten in die Tabelle interner Auftrag

.Cells(2, 2) = Cells(ActiveCell.Row, 1) ' gibt die interne Nummer zurück
.Cells(5, 2) = vntin(1, 3)  ' gibt das Bauvorhaben zurück
.Cells(7, 4) = vntin(1, 3)  ' gibt das Bauvorhaben zurück
.Cells(5, 7) = vntin(1, 9)  ' gibt den Auftraggeber über zurück
.Cells(5, 5) = vntin(1, 33) ' gibt den Auftraggeber zurück
.Cells(6, 3) = vntin(1, 38) ' gibt den Projektleiter zurück
.Cells(6, 5) = vntin(1, 39) ' gibt die Telefonnummer vom Projektleiter zurück
.Cells(6, 6) = vntin(1, 40) ' gibt die E-Mail vom Projektleiter zurück
.Cells(8, 4) = vntin(1, 5) & "/" & vntin(1, 6) ' gibt die PLZ und den Ort vom BV zurück
.Cells(9, 4) = vntin(1, 7) ' gibt die Straße vom BV zurück
.Cells(11, 4) = vntin(1, 8) & "/" & vntin(1, 9) ' gibt den Ansprechpartner "Abwicklung über"/Firma zurück
.Cells(5, 7) = vntin(1, 9) ' gibt Abwicklung über die Firma zurück im Kopf
.Cells(11, 5) = vntin(1, 14) ' gibt vom Ansprechpartner "Abwicklung über" die Telefonnummer zurück
.Cells(10, 4) = vntin(1, 16) & "/" & vntin(1, 17) ' gibt den Ansprechpartner vor Ort/ Firma zurück
.Cells(12, 4) = vntin(1, 38) & "/" & vntin(1, 33) ' gibt den Ansprechpartner Auftraggeber/ Firma zurück
.Cells(12, 5) = vntin(1, 39) ' gibt vom Ansprechpartner Auftraggeber die Telefonnummer zurück
.Cells(10, 5) = vntin(1, 22) ' gibt vom Ansprechpartner vor Ort die Telefonnummer zurück
.Cells(22, 2) = vntin(1, 45) ' gibt die Angebotsnummer zurück
.Cells(23, 2) = vntin(1, 44) ' gibt das Angebotsdatum zurück
.Cells(24, 2) = vntin(1, 38) ' gibt Beauftragt von zurück
.Cells(19, 5) = vntin(1, 43) ' gibt Anmerkungen zum Bauvorhaben und die Schadensbeschreibung vom Onlineformular zurück
.Cells(22, 3) = "Freitext Interner Auftrag:" & vbCrLf & vntin(1, 46) ' gibt den Freitext Interner Auftrag zurück
.Cells(14, 5) = vntPers(1, j + 1) ' gibt das Fahrzeug zurück
.Cells(13, 3) = dteStart & " - " & dteEnde ' gibt das Ausführungsdatum zurück
.Cells(14, 3) = vntPers(1, j) ' gibt die Mitarbeiter zurück
.Cells(19, 3) = vntin(1, 31)
.Cells(14, 7) = IIf(UBound(Split(vntPers(1, j), Chr(10))) > 0, Split(vntPers(1, j), Chr(10))(i - 1), vntPers(1, j)) ' trägt den Verantwortlichen ein
.Cells(63, 4) = "Ladestraße, Calau"
.Cells(63, 6) = vntin(1, 7) & ", " & vntin(1, 5) & " " & vntin(1, 6) ' trägt den Ort vom BV zur Entfernungsberechnung ein
.Cells(19, 1) = "Information zum Schaden/ Beschädigung:" & vbCrLf & vntin(1, 31) ' gibt die Schadensinfos vom Onlineformular zurück
If vntin(1, 29) = "X" Then .Cells(61, 1) = "Die Unterkunft ist gebucht. Die Buchungsunterlagen wurden den entsprechenden Mitarbeitern weiter geleitet"
If vntin(1, 30) = "X" Then .Cells(62, 1) = "Der Flug ist gebucht. Die Buchungsunterlagen wurden den entsprechenden Mitarbeitern weiter geleitet"
If vntin(1, 29) = "" Then .Cells(61, 1) = "Keine Unterkunft gebucht!"
If vntin(1, 30) = "" Then .Cells(62, 1) = "Kein Flug gebucht!"

End With

 

 

 

 

 

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot werte aus drei Tabellen...suchen, vergleichen und eintragen
13.12.2017 15:04:19 Søren
NotSolved
14.12.2017 07:49:21 Søren
Solved