Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro zum umbenennen
#1

.xlsx   Mappe für CEF.xlsx (Größe: 47,79 KB / Downloads: 7) Hallo,

ich habe in meiner Datei (einen Auszug dazu habe ich beigefügt) ein Arbeitsblatt, was zur Zeit noch "Testblatt" heißt.

Ich suche ein Makro, dass folgendes macht:

das Makro soll im Blatt "Testblatt" in der Spalte "B" (Linie) nach der 772 schauen.
Findet das Makro die 772 und in Spalte "D" (Ort) steht ein Ortsteil, der "Blo.", ein "Bar." oder ein "H-B.M." enthält und gleichzeitig in Spalte "F" (Ort) ebenfalls ein "Blo.", ein "Bar." oder ein "H-B.M." enthält, soll aus der 772 in Spalte B eine "772.1" entstehen.

Ich weiß nicht, wie ich das umsetzen kann.

Vielleicht kann mir jemand helfen.

Viele Grüße
Andreas
Antwortento top
#2
Hallo

so?
Code:
Sub Neu772()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
   
    With Sheets("Testblatt")
        If .FilterMode Then .ShowAllData ' Autofilter alle
       
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
       
        For i = 4 To LR
            If .Cells(i, 2) = "772" Then
               
                If InStr(.Cells(i, 4), "Bar.") > 0 Or InStr(.Cells(i, 4), "Blo.") > 0 _
                    Or InStr(.Cells(i, 4), "H-B.M.") > 0 Then
                       
                        If InStr(.Cells(i, 6), "Bar.") > 0 Or InStr(.Cells(i, 6), "Blo.") > 0 _
                            Or InStr(.Cells(i, 6), "H-B.M.") > 0 Then
                                .Cells(i, 2) = "'772.1" 'mit Hochkomma sonst wird es als Kommazahl angesehen
                        End If
               
                End If
               
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

LG UweD
[-] Folgende(r) 1 Benutzer sagt Danke an UweD für diesen Beitrag:
  • ari-2001
Antwortento top
#3
Hallo Uwe,

super, hab vielen Dank!

Viele Grüße
Andreas
Antwortento top
#4
Hallo Andreas,
etwas spät, aber ich will nicht umsonst gearbeitet haben:
Code:
Sub Umbenennen()
Dim found As Object, lastrow As Long
Const BName = "Testblatt" 'ggfls. anpassen
Const Suche = "772" 'ggfls. anpassen
  With ThisWorkbook.Sheets(BName)
    If .AutoFilter.FilterMode Then .ShowAllData
    Set found = .Range("B:B").Find(what:=Suche, LookIn:=xlValues, lookat:=xlWhole)
    If Not found Is Nothing Then
      Do
        lastrow = found.Row
        If Ortsteil(found) Then Range(found.Address) = Suche & ".1"
        Set found = .Range("B:B").FindNext(found)
      Loop Until found.Row < lastrow
    End If
  End With
End Sub
Function Ortsteil(SpB As Object) As Boolean
Dim erg As Boolean, erg1 As Boolean, sB1, sB2
Dim Sucharr
  Sucharr = Array("Blo.", "Bar.", "H-B.M.")
  For Each sB1 In Sucharr
    If InStr(1, SpB.Offset(0, 2).Text, sB1) > 0 Then
      For Each sB2 In Sucharr
        If InStr(1, SpB.Offset(0, 4).Text, sB2) > 0 Then
          erg = True
          Exit For
        End If
      Next sB2
      If erg Then Exit For
    End If
  Next sB1
  Ortsteil = erg
End Function
Gruß der AlteDresdner (Win10, Off2010)
[-] Folgende(r) 1 Benutzer sagt Danke an AlterDresdner für diesen Beitrag:
  • ari-2001
Antwortento top
#5
Klasse,

funktioniert auch wie der Teufel Smile



Viele Grüße

Andreas

Hallo Uwe,
funzt ganz prima.
Kann man noch eine zweite Routine mit einbauen,
die nochmal das gleiche macht, nur eben mit einer anderen Linie und anderen Bedingungen?
So würde ich jetzt sonst das gleiche Makro noch mal "kopieren" und es an die Bedingungen anpassen.
Vielleicht kann man ja noch einen Durchlauf in diesem Makro starten, der dann die verbleibenden 772, wenn dort "DT." und "H-B.M." vorkommt, in 772.2
umbenennt.
Da bin ich grade am tüfteln.
Vielleicht kannst Du mir da bei noch einmal helfen?
Viele Grüße
Andreas

Antwortento top
#6
Hi


im Prinzip so

!!!Ungeprüft. !!!

        For i = 4 To LR
            If .Cells(i, 2) = "772" Then
               
                'Prüfung 1
                 If InStr(.Cells(i, 4), "Bar.") > 0 Or InStr(.Cells(i, 4), "Blo.") > 0 _

                    Or InStr(.Cells(i, 4), "H-B.M.") > 0 Then
                       
                        If InStr(.Cells(i, 6), "Bar.") > 0 Or InStr(.Cells(i, 6), "Blo.") > 0 _
                            Or InStr(.Cells(i, 6), "H-B.M.") > 0 Then
                                .Cells(i, 2) = "'772.1" 'mit Hochkomma sonst wird es als Kommazahl angesehen
                        End If
               
                 End If
                 
                 'Prüfung 2
                 If InStr(.Cells(i, 4), "DT.") > 0 Then
                       
                        If InStr(.Cells(i, 6), "H-B.M.") > 0 Then
                                .Cells(i, 2) = "'772.2" 'mit Hochkomma sonst wird es als Kommazahl angesehen
                        End If
               
                End If              
            End If
        Next





LG UweD
[-] Folgende(r) 1 Benutzer sagt Danke an UweD für diesen Beitrag:
  • ari-2001
Antwortento top
#7
Hallo Uwe,

gaaaaaaaanz herzlichen Dank, genauso so funktioniert es wie verückt Smile

Merci
Andreas
Antwortento top
#8
Code:
Sub M_snb()
  [b4:B100].numberformat="@"
  [b4:B100].Offset(, 10) = [B4:B200 & if((B4:B200=772)*(IFERROR(SEARCH("Blo.",D4:D200),0) +IFERROR(SEARCH("Bar.",D4:D200),0)+IFERROR(SEARCH("H-B.M.",D4:D200),0)>0)+(IFERROR(SEARCH("Blo.",F4:F200),0) +IFERROR(SEARCH("Bar.",F4:F200),0)+IFERROR(SEARCH("H-B.M.",F4:F200),0)>0)=2,".1","")]
End Sub
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
[-] Folgende(r) 1 Benutzer sagt Danke an snb für diesen Beitrag:
  • ari-2001
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste