sheetname bestaat al

[Spiesse]

Beste,

onderstaande macro hernoemt elke tabbladnaam in een bestand naar de waarde in cel D1. So far so good. Nu gebeurt het dat de tabbladnaam reeds bestaat, dus dat er een dubbele naam voorkomt. Dit kan in excel niet. Hoe pas ik de macro aan dat deze tabbladnaam dan een (2) achter de naam krijgt en de macro gewoon verderloopt?

Sub RenameSheets()
For i = 2 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("d1").Value
End If
Next

End Sub

thx in advance!
Spiesse

 

[pasan]

Sub RenameSheets()
For i = 2 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" Then
Sheets(i).Name = IIf(Sheets(i).Name = Worksheets(i).Range("d1").Value, Sheets(i).Name, Worksheets(i).Range("d1"))
End If
Next
End Sub

 

[Spiesse]

hmhm, ik krijg een foutmelding over een bestandsnaam die al bestaat ed...

ergens iets mis?

toch al bedankt e pasan

 

[pasan]

zo dan

Sub RenameSheets()
For i = 2 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" And Worksheets(i).Range("d1") <> "" Then
Sheets(i).Name = IIf(Sheets(i).Name = Worksheets(i).Range("d1").Value, Sheets(i).Name, Worksheets(i).Range("d1"))
End If
Next
End Sub

 

[Spiesse]

neen, ook niet...

het is als een vorige tabbladnaam al de waarde van d1 heeft, dat dit zou moeten aangepast worden...

in ieder tabblad haal ik een deel van een tekst via een formule, en die staat in cel d1. deze celinhoud wordt dan gebruikt om de tabbladnaam te veranderen... dus als een om te vormen tabbladnaam al bestaat zou er een (2) moeten achterstaan in de tabbladnaam.

natuurlijk kan het zijn dat deze tabbladnaam dan nog es voorkomt...

wordt niet zo makkelijk denk ik dan...

 

[pasan]

On Error Resume Next

als je dit boven aan zet gaat het goed zonder melding welliswaar

 

[Spiesse]

pasan,

tot nu toe heb ik dit al gevonden

Sub RenameSheets()
On Error GoTo change
'Resume Next
For i = 2 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("d1").Value
End If
Next
change:
Sheets(i).Name = Worksheets(i).Range("d1") & "(2)"

End Sub

wat nu gebeurt is dat een reeds bestaand tabblad hernoemt wordt, dus ok in principe.

Enkel is het volgende nog aan de beurt. als de tabbladnaam nog es voorkomt, zou die (2) moeten veranderen in (3), dus telkens oplopen... dat wordt tricky zeker?

 

[wampier]

Zet alle potentiële namen eerst een lijst, haal daar de dubbelen uit en pas dan je lijst toe op de sheetnamen.

 

[Spiesse]

de dubbelen mogen niet verwijderd worden, helaas

dus verderbomen op de laatste macro van mij vrees ik

 

[wampier]

Ik zeg toch niet verwijderen? Ik geef alleen aan dat je beter eerst de hele lijst kan bouwen en daar de namen in veranderen en plaats van een voorwaartse iteratie, wat de problemen geeft waar je nu tegenaan loopt.

 

[snb]

Sub RenameSheets()
  For j = 2 To Sheets.Count
    with sheets(j)
       If .Range("A1").Value <> "" Then .Name = .Range("d1").Value & iif(evaluate("isref(" & .Range("d1").Value & "!A1)"),"(2)","")
    end with
  Next
End Sub

 

[Spiesse]

Ik zeg toch niet verwijderen? Ik geef alleen aan dat je beter eerst de hele lijst kan bouwen en daar de namen in veranderen en plaats van een voorwaartse iteratie, wat de problemen geeft waar je nu tegenaan loopt.

laat je gaan wampier

 

[wampier]

zoiets:

Sub rename()
Dim opslag() As String
ReDim opslag(Sheets.Count)
    For i = 2 To Sheets.Count
        If Sheets(i).[a1].Value <> "" Then
            opslag(i) = Sheets(i).[d4].Value
        Else
            opslag(i) = Sheets(i).Name
        End If
    Next i
    For i = 2 To Sheets.Count
        nummer = 2
        verg = opslag(i)
        For j = i + 1 To Sheets.Count
            If opslag(j) = verg Then
                opslag(j) = opslag(j) & "(" & nummer & ")"
                nummer = nummer + 1
            End If
        Next j
    Next i
    
    For i = Sheets.Count To 2 Step -1
        Sheets(i).Name = opslag(i)
    Next i
End Sub

*edit* overigens bestaan er situaties waar dit toch nog tot errors kan leiden, in dat geval is er nog een kleine tussenstap nodig afhankelijk van gebruik en situaties

 

[pasan]

Probeer deze eens
kreeg het alleen aan de praat nadat de werkbladen gesorteerd waren van bsalv de volgende code om te sorteren gebruikt
http://www.worksheet.nl/forumexcel/afgehandelde-vragen/81647-werkbladen-sorteren-en-spaties-negeren.html

Dim x As Integer, t As Boolean, OldWorksheetName As String, a As String

Sub RenameSheets()
x = 0
SorterenWerkbladen
For i = 2 To Sheets.Count
If Worksheets(i).Range("D1") <> Sheets(i).Name Then
If Worksheets(i).Range("A1").Value <> "" And Worksheets(i).Range("D1").Value <> "" Then

c = Sheets(i).Name
a = Worksheets(i).Range("d1").Value

WorksheetExists (a)
 If t Then
   Sheets(i).Name = a & "(" & x & ")"
 Else
  Sheets(i).Name = a
 End If
End If
End If
t = False
Next

x = 0
r = 0
a = ""
OldWorksheetName = ""
End Sub

Sub SorterenWerkbladen()
'met dank aan bsalv
  Dim Arr, i As Integer, shNieuw As Worksheet

  Set shNieuw = Sheets.Add
  ReDim Arr(1 To ThisWorkbook.Worksheets.Count, 1 To 2)
  For i = 1 To ThisWorkbook.Worksheets.Count               'alle werkbladen aflopen
    Arr(i, 1) = Replace(Worksheets(i).Name, " ", "")       'werkbladnaam zonder spaties
    Arr(i, 2) = Worksheets(i).Name                         'echte werkbladnaam
  Next

  With shNieuw.Cells(1).Resize(UBound(Arr), UBound(Arr, 2))  'in het nieuw toegevoegde blad
    .Value = Arr                                           'schrijf je alles weg
    .Sort .Cells(1), Header:=xlNo                          'sorteer je op de 1e kolom
    Arr = .Value                                           'lees je dat weer uit
  End With


  For i = 2 To UBound(Arr)                                 'die array aflopen van 2e record tot einde
    Sheets(Arr(i, 2)).Move after:=Sheets(Arr(i - 1, 2))    'op volgorde zetten
  Next i

  Application.DisplayAlerts = False
  shNieuw.Delete                                           'nieuw toegevoegde werkblad weer verwijderen
  Application.DisplayAlerts = True

End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    
    Dim Sht As Worksheet
        
    WorksheetExists = False
     
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name = WorksheetName Then
        WorksheetExists = True
        t = True
        x = x + 1
        End If
      If a <> OldWorksheetName Then
       x = 1
       End If
    Next
 OldWorksheetName = a
End Function

 

[pasan]

NEE deze werkt niet onder alle omstandigheden

 

[snb]

Dat doet de suggestie in #11 wel.

 

[gGerretje]

Ik volg het aandachtig.
Volgens mij heeft snb gelijk.
Als je al een werkblad met de naam Pietje hebt en er staat weer een Pietje ergens in D1, krijgt dat blad netjes de naam Pietje(2)

Groet
Ger

 

[sylvester-ponte]

Spiesse,
moet pietje(2), pietje(3) worden?
en als pietje(3) al bestaat dat pietje(2) pietje(4) wordt enz.
dus notaties als pietje(2)(2) is dat nou de bedoeling of moet je dan pietje(3) proberen?

 

[Spiesse]

goedemorgen Sylvester en andere collega's,

leuk te lezen na een weekendje dat dit topic aanslaat Het is dan ook een goede vraag, nietwaar?

nu, Sylvester, betreffende uw vraag: dit is idd de opzet. Stel nu dat er 4 tabbladen zijn met pietje, dan moet het eerste tabblad pietje blijven, de tweede keer dat pietje voorkomt moet dit pietje (2) worden, de derde keer dat pietje voorkomt moet dit pietje(3) worden enz...

ik probeer de geposte macro's al es om te kijken wat daar tussen zit...

groeten,
Spiesse

 

[wampier]

Mijn versie kan dit in principe, Er is 1 snafu: de macro gaat ervan uit dat je steeds pagina's toevoegt aan het einde. Indien je ook pagina's toe wil voegen in het midden of pagina's wil verwijderen dan zijn er nog 3 regeltjes extra nodig om dit op te vangen.