Thema Datum  Von Nutzer Rating
Antwort
20.06.2021 11:36:30 Yannick
NotSolved
20.06.2021 13:18:59 Gast24717
NotSolved
20.06.2021 16:14:41 Yannick
NotSolved
21.06.2021 15:18:36 Gast6711
NotSolved
Rot Zellenwerte überschreiben & verteilen
21.06.2021 15:25:10 Gast58526
NotSolved
21.06.2021 18:40:49 Gast8353
NotSolved
20.06.2021 13:19:41 Mase
Solved

Ansicht des Beitrags:
Von:
Gast58526
Datum:
21.06.2021 15:25:10
Views:
288
Rating: Antwort:
  Ja
Thema:
Zellenwerte überschreiben & verteilen

Das hier ist der momentane Stand. Allerdings variierein die Namen und Reihenfolgen der Soalten. Daher ist der Code unten nicht ganz anwendbar.

Option Explicit
  
Sub ChangeID()
   
    Const wsBaseName As String = "Tabelle"
    Const idBaseName As String = "ABC"
       
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' ignore case of 'idBaseName'
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet
    Dim rg As Range
    Dim cCell As Range
    Dim Key As Variant
    Dim lRow As Long
    Dim n As Long
    
    For Each ws In wb.Worksheets
        ' Only if the worksheet name starts with 'wsBaseName'
        ' and ignoring case ('TaBeLlE = Tabelle').
        If InStr(1, ws.Name, wsBaseName, vbTextCompare) = 1 Then
            lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            If lRow > 1 Then ' check if any id's
                Set rg = ws.Range("A2:A" & lRow)
                For Each cCell In rg.Cells
                    Key = CStr(cCell.Value)
                    If Not dict.Exists(Key) Then
                        n = n + 1
                        dict.Add Key, idBaseName & n
                    End If
                    cCell.Value = dict(Key)
                Next cCell
            End If
        End If
    Next ws
    
    MsgBox "Done.", vbInformation, "Change ID"
   
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
20.06.2021 11:36:30 Yannick
NotSolved
20.06.2021 13:18:59 Gast24717
NotSolved
20.06.2021 16:14:41 Yannick
NotSolved
21.06.2021 15:18:36 Gast6711
NotSolved
Rot Zellenwerte überschreiben & verteilen
21.06.2021 15:25:10 Gast58526
NotSolved
21.06.2021 18:40:49 Gast8353
NotSolved
20.06.2021 13:19:41 Mase
Solved