Makro zum umbenennen

[ari-2001]

  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

[UweD]

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

[ari-2001]

Hallo Uwe,

super, hab vielen Dank!

Viele Grüße
Andreas

[AlterDresdner]

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

[ari-2001]

Klasse,

funktioniert auch wie der Teufel



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

---

[UweD]

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

[ari-2001]

Hallo Uwe,

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

Merci
Andreas

[snb]

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