String Teilen

[And61]

Hallo Zusammen,

ich habe in einem Makro Strings in folgender Form ausgelesen:
"=Kalkulation!$A16:$A100"

(Bereiche der Namen im Namensmanager)

die 100 soll nun durch die jeweils aktuelle Zeilenzahl z.B. 2325 erstez werden, es kann aber auch nur 25 sein.

diese neue Zeilenzahl habe ich als Variable, aber mir gelingt es nicht den String
"=Kalkulation!$A16:$A" zu ermitteln, damit ich dem Namen den Bereich
"=Kalkulation!$A16:$A" & kRow
zuweisen kann.

Kann mir jemand auf die Sprünge helfen?

Martin

Betreff mit "r" ergänzt.
Moderator [Bild: smilie.php?smile_ID=1810]

[atilla]

Hallo,

Die Zweite Zeile sollte richtig funktionieren.

Hier mal eine Routine zum Testen:

Code:

Sub test()

   Dim strgText As String
   Dim kRow As Long
  
   strgText = "=Kalkulation!$A16:$A100"
   MsgBox " zeuerst: " & vbLf & vbLf & strgText
  
   kRow = 20
   strgText = "=Kalkulation!$A16:$A" & kRow
   MsgBox "nach Zuweisung eines neuen Werts an kRow: " & vbLf & vbLf & strgText
  
End Sub

Vielleicht kommst Du damit weiter. Sonst zeig mal etwas mehr Code.

[Kuwer]

Hallo Martin,

Code:

Sub BereichsnamenAendern()
  Dim lngZeile As Long
  lngZeile = 21
  Names("Keine_Ahnung").RefersTo = "=Kalkulation!$A16:$A" & lngZeile
End Sub

Gruß Uwe

[And61]

Hallo und danke erst mal für die Antwort.

Soweit so gut, aber da kann ich auch gleich alle 100 Namen einzeln ansprechen...

Ich will die 100 am ende gegen eine andere Zahl tauschen und will eigentlich die Position des letzten $ ermitteln, damit ich den String "=Kalkulation!$A16:$A" mit der neuen Zeilenzahl ergänzen kann.

strTeiltext = "=Kalkulation!$A16:$A"

damit ich dann Jeden Namen entsprechend ändern kann:
Names("Keine_Ahnung").RefersTo = strTeiltext " & lngZeile

So stelle ich mir das vor:

Code:

Sub Namensbereich_ändern()
   '
   Dim oName As Name
   Dim lngZeile As Long
   Dim strAdr As String
   Dim strTeiltext As String
  
    strRow = ActiveSheet.UsedRange.Rows.Count
    For Each oName In ActiveWorkbook.Names
        '
        If InStr(oName.RefersTo, "#REF") = 0 Then
            
           If Left(oName.Name, 3) = "KA_" Then 'alle Namen beginnend mit KA_ bearbeiten
                    Stop
                strAdr = oName.RefersTo ' ergibt z.B. "=Kalkulation!$A16:$A100"

                strTeiltext = Right(strAdr, InStr(strAdr, "!")) 'hier wird "$A16:$A100" zugewiesen
                'irgendwie soll hier aber letztenendes ermittelt werden, wieviele Zeichen nach dem letzten $ stehen,
                'damit ich den String mit strTeiltext =Left(strAdr, <anhzal der Zeichen>)ermitteln kann um dann
                Names(oName.Name).RefersTo = strTeiltext & lngZeile 'den neuen Bereich zuweisen kann
            
           End If
        End If
    Next
   '
End Sub

[atilla]

Hallo,

dann ginge so etwas:

Code:

Public Sub Namensbereich_erweitern()
   Dim kRowAlt As Long, kRowNeu
   Dim objName As Name
   kRowAlt = 10
   kRowNeu = 100

   On Error GoTo Fin
   For Each objName In ThisWorkbook.Names
       objName.RefersTo = Replace(objName.RefersTo, kRowAlt, kRowNeu)
   Next objName
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

Hier wird vorausgesetzt, das die Zahlen eindeutig immer einmal im Namen vorkommen.
Wenn das nicht reicht, dann melde Dich noch einmal.

[atilla]

Hallo,

hier eine weitere Variante, die Deinem Wunsch eher entspricht:

Code:

Public Sub Namensbereich_erweitern()
   Dim kRowAlt As Long, kRowNeu
   Dim objName As Name

   kRowNeu = 10

   On Error GoTo Fin
   For Each objName In ThisWorkbook.Names
      kRowAlt = Split(objName.RefersTo, "$")(4)
       objName.RefersTo = Replace(objName.RefersTo, kRowAlt, kRowNeu)
   Next objName
  
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

[atilla]

Hallo,

sorry, das zuletzt gepostete zu schnell geschossen.

geht zwar in die richtige Richtung, aber Fehlerhaft.

Melde mich später wieder, wenn noch keine Lösung eingestellt wurde.

[atilla]

Hallo,

das müsste jetzt klappen:

Code:

Public Sub Namensbereich_erweitern()
   Dim kRowAlt As Long, kRowNeu
   Dim objName As Name

   kRowNeu = 10

   On Error GoTo Fin
   For Each objName In ThisWorkbook.Names
      kRowAlt = Len(objName.RefersTo) - Len(Mid(objName.RefersTo, InStrRev(objName.RefersTo, "$") + 1))
      objName.RefersTo = Left(objName.RefersTo, kRowAlt) & kRowNeu
   Next objName
  
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

[And61]

Danke Atilla,

ich habe den vorletzten Vorschlag probiert, funktioniert, aber er reicht nicht ganz aus.
Es muss ja nicht jeder Name geändert werden, im 2. Durchlauf kommt dann z.B. der Pfad mit Dateiname und das Makro läuft auf Fehler.

Drum habe ich ja

If InStr(oName.RefersTo, "#REF") = 0 Then

If Left(oName.Name, 3) = "KA_"
eingebaut, damit nur die Namen bearbeitet werden, die so Beginnen.

Parallel habe ich weiter geforscht und folgende Lösung gefunden:

Code:

Sub Namensbereich_ändern()
   '
   Dim oName As Name
   Dim lngZeile As Long
   Dim strAdr As String
   Dim strTeiltext As String
  
    lngZeile = ActiveSheet.UsedRange.Rows.Count
    For Each oName In ActiveWorkbook.Names
        '
        If InStr(oName.RefersTo, "#REF") = 0 Then
            
           If Left(oName.Name, 3) = "KA_" Then 'alle Namen beginnend mit KA_ bearbeiten
                    Stop
                strAdr = oName.RefersTo ' ergibt z.B. "=Kalkulation!$A16:$A100"

                strTeiltext = Left(strAdr, InStrRev(strAdr, "$")) 'ergibt "=Kalkulation!$A16:$A"
                
                ' Damit kann ich das zusammenführen
                Names(oName.Name).RefersTo = strTeiltext & lngZeile
                
           End If
        End If
    Next
   '
End Sub

InStrRev war die Lösung, hier hatte ich das zwar auch schon mal verwendet, aber nicht beachtet, dass da 2 Zahlen berechnet wurden und die 2. von der 1. abgezogen wurden, so ergab das immer die falsche Zahl und der String wurde entsprechend falsch ausgegeben.

Da war er wieder, der Wald mit Lauter Bäumen.

Noch mal Danke, auf jeden Fall wurde ich ja in die richtige Richtung geschubst.
:26:

[Kuwer]

Hallo,

ich würde es jetzt nicht von den Dollars abhängig machen.

Code:

Sub BereichsnamenAendern()
  Dim lngZeile(1 To 2) As Long
  Dim oName As Name
  lngZeile(2) = 100
  For Each oName In Names
    With oName
      If InStr(.RefersTo, "#REF") = 0 Then
        If Left(.Name, 3) = "KA_" Then 'alle Namen beginnend mit KA_ bearbeiten
          lngZeile(1) = .RefersToRange.Rows.Count + .RefersToRange.Row - 1
          .RefersTo = Left(.RefersTo, Len(.RefersTo) - Len(CStr(lngZeile(1)))) & CStr(lngZeile(2))
        End If
      End If
    End With
  Next oName
End Sub

Gruß Uwe