Identifikationsnummer in Datei 1 auslesen und Daten in Datei 2 einfügen

[schauan]

Hallöchen,

Du kannst gerne auch am Anfang der Schleife oder passender Stelle die Farbe zurücksetzen.

.Cells(i,3).Interior.Color=xlNone

[Petz1807]

Vielen lieben Dank schauan doch vielleicht kannst du mir noch bei einer VBA änderung vielleicht weiter helfen denn es geht um folgenden VBA Script:

Sub Ajouter_matricule()
'If Selection.Column <> 2 Then MsgBox "Vous pouvez sélectionner les Matricules": Exit Sub
'If Selection.Row = 1 Then Cells(2, 2).Select
Range("B1").Select
For i = Selection.Row To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 17) <> "" Then
        Ar = Split(Cells(i, 17))
        P1 = InStrRev(Ar(0), "-")
        Ar(0) = Left(Ar(0), P1) & Cells(i, 2)
        Cells(i, 17) = Join(Ar, " ")
        'zum Testen
        'Cells(i, 19) = Join(Ar, " ")
    End If
Next i
End Sub

Dieser Script macht folgendes in der Excel Tabelle:

       A           B            C     D    E    F   G   H   I   J   K   L   M   N   O   P                                 Q
 1             123456                                                                                LAR-CREDOC-123456 du XX/XX/2019
 2             234567                                                                                LAR-CREDOC-234567 du XX/XX/2019
 3             5678908

Er hollt in Spalte B die Zahl und fügt die dann in Spalte Q hinter LAR-CREDOC-...... ein

Jetzt meine 2 Fragen wie kann ich diesen Script ändern dass er mir automatisch LAR-CREDOC-xxxx du xx/xx/2019 in Spalte Q schreibt wenn er in die nächste Zeile springt ?

Und meine zweite Frage wie kann ich auch noch hinzufügen dass er mich zuerst nach dem Jahr fragt das er hinter XX/XX/.... schreibt zb. 2019

Hoffe hab mich jetzt nicht zu kompliziert ausgedrückt

Vielen lieben dank nochmals

[schauan]

Hallöchen,

zu 1)
so etwa
Cells(i, 17) = "LAR-CREDOC-123456 du XX/XX/2019 " & Join(Ar, " ")


zu 2)
so etwa
strJahr = Inpubox("Eingabe Jahr:",,year(Date))
Cells(i, 17) = "LAR-CREDOC-123456 du XX/XX/" & strjahr & " " & Join(Ar, " ")

[Petz1807]

Vielen dank und auf welcher Position im Script soll ich das genau einfügen

[Petz1807]

Die Nummer 123456 muss er aus Spalte B auslesen und hinter CREDOC- einfügen   LAR-CREDOC-123456 du XX/XX/2019

[schauan]

Hallöchen,

die Position ist einfach zu finden - dort wo jetzt schon am Anfang Cells(i, 17) = steht und im Rest der Zeile Join(Ar, " ")

Eine Zeichenkette kann man sich mit den "" und den & zusammenbauen.

Statt
strJahr = Inpubox("Eingabe Jahr:",,year(Date))
Cells(i, 17) = "LAR-CREDOC-123456 du XX/XX/" & strjahr & " " & Join(Ar, " ")

dann z.B.

strJahr = Inpubox("Eingabe Jahr:",,year(Date))
Cells(i, 17) = "LAR-CREDOC-" & Join(Ar, " ") &  "du XX/XX/" & strjahr

wobei ich jetzt nicht weiß, was da mit den Leerzeichen von Join(Ar, " ") passieren soll … Du holst ja mit dem Ar die Daten aus der Spalte B:
Ar(0) = Left(Ar(0), P1) & Cells(i, 2)

Wenn Du das anders verarbeiten willst als bisher - nur den Inhalt aus der jeweiligen Zeile aus B , müsstest Du eventuell das nehmen:
strJahr = Inpubox("Eingabe Jahr:",,year(Date))
Cells(i, 17) = "LAR-CREDOC-" & Cells(i, 2) &  "du XX/XX/" & strjahr

Dann ist aber eventuell das alles überflüssig:
Ar = Split(Cells(i, 17))
P1 = InStrRev(Ar(0), "-")
Ar(0) = Left(Ar(0), P1) & Cells(i, 2)

[Petz1807]

Code:

Sub Ajouter_la_Matricule()
Dim i As Long, Ar As Variant, P1 As Long

For i = Selection.Row To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 17) <> "" Then
        Ar = Split(Cells(i, 17))
        P1 = InStrRev(Ar(0), "-")
        Ar(0) = Left(Ar(0), P1) & Cells(i, 2)
        
        strjahr = InputBox("Eingabe Jahr:", , Year(Date))
        Cells(i, 17) = "LAR-CREDOC-" & Join(Ar, " ") & "du XX/XX/" & strjahr

    End If
Next i
End Sub

Hab den die Zeilen jetzt ersetzt doch jetzt bekomme ich eine Fehlermeldung

[snb]

Code:

Sub M_snb()
   for each it in columns(17).specialcells(2,2)
     if left(it,11)="LAR-CREDOC-" then it = replace(it,left(it,11),left(it,11) & it.offset(,-15))
   next
End Sub

[schauan]

Hallöchen,

doch jetzt bekomme ich eine Fehlermeldung

Leider kann ich Deine Meldung von hier aus nicht sehen

[Petz1807]

Hallo Schauan,

Hab herausgefunden an was das Problem lag der Code läuft jetzt doch hab jetzt noch eine weiter Hürde eingebaut denn will auch in Spalte 14 dass er das Jahr hinschreibt jetzt hab ich die Zeile in den Code hinzugefügt doch jetzt schreibt er mir nur in der ersten Zeile in Spalte 14 das Jahr will aber ab Zeile 2 nach unten das Jahr.

Code:

Sub Ajouter_la_Matricule()

Dim strJahr As String
Dim i As Long

strJahr = InputBox("Quelle année?:", , Year(Date))

If Len(strJahr) <> 4 Or IsNumeric(CStr(strJahr)) = False Then
MsgBox "Vous devez inscrire une année à quatre chiffres," & vbCrLf & _
"Example, 2019", 48, "MAUVAISE INSCRIPTION"
Exit Sub
End If

Range("B2").Select

For i = Selection.Row To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 17) <> "" Then

Cells(14) = "" & strJahr
Cells(i, 17) = "LAR-CREDOC-" & Cells(i, 2) & "du XX/XX/" & strJahr

End If

Next i

End Sub

Wo liegt da der Fehler?