Hi there! As a fellow VBA learner, I’ve put together a solution that handles both your requirements efficiently—even for files with 1000+ records. The code uses dictionaries for fast lookups (critical for large datasets) and breaks the process into clear, easy-to-follow steps.

Full VBA Code #

Sub ProcessTitlesAndAddresses()
    ' Define constants for easy adjustment (tweak these based on your file)
    Const DATA_COLUMN As String = "A" ' Change to your target column (e.g., "B" if titles are in column B)
    Const START_ROW As Long = 1 ' Start processing from this row (adjust if you have headers)
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim titleCountDict As Object
    Dim occurrenceTracker As Object
    Dim currentRow As Long
    Dim currentValue As String
    
    ' Set the worksheet to process (uses the active sheet; change to Sheet1 if needed)
    Set ws = ActiveSheet
    ' Find the last row with data to avoid unnecessary loops
    lastRow = ws.Cells(ws.Rows.Count, DATA_COLUMN).End(xlUp).Row
    
    ' --------------------------
    ' Step 1: Count title occurrences
    ' --------------------------
    Set titleCountDict = CreateObject("Scripting.Dictionary")
    For currentRow = START_ROW To lastRow
        currentValue = Trim(ws.Cells(currentRow, DATA_COLUMN).Value)
        ' Skip empty cells and "Address" entries
        If currentValue <> "" And currentValue <> "Address" Then
            If titleCountDict.Exists(currentValue) Then
                titleCountDict(currentValue) = titleCountDict(currentValue) + 1
            Else
                titleCountDict.Add currentValue, 1
            End If
        End If
    Next currentRow
    
    ' --------------------------
    ' Step 2: Add unique suffixes to duplicate titles
    ' --------------------------
    Set occurrenceTracker = CreateObject("Scripting.Dictionary")
    For currentRow = START_ROW To lastRow
        currentValue = Trim(ws.Cells(currentRow, DATA_COLUMN).Value)
        If currentValue <> "" And currentValue <> "Address" Then
            ' Only add suffix if the title has duplicates
            If titleCountDict(currentValue) > 1 Then
                If occurrenceTracker.Exists(currentValue) Then
                    occurrenceTracker(currentValue) = occurrenceTracker(currentValue) + 1
                Else
                    occurrenceTracker.Add currentValue, 1
                End If
                ' Update the cell with the suffixed title
                ws.Cells(currentRow, DATA_COLUMN).Value = currentValue & occurrenceTracker(currentValue)
            End If
        End If
    Next currentRow
    
    ' --------------------------
    ' Step 3: Rename "Address" entries to match their parent title
    ' --------------------------
    For currentRow = START_ROW To lastRow
        currentValue = Trim(ws.Cells(currentRow, DATA_COLUMN).Value)
        If currentValue = "Address" Then
            ' Avoid errors on the first row
            If currentRow > START_ROW Then
                Dim parentTitle As String
                parentTitle = Trim(ws.Cells(currentRow - 1, DATA_COLUMN).Value)
                ws.Cells(currentRow, DATA_COLUMN).Value = parentTitle & " Address"
            End If
        End If
    Next currentRow
    
    ' Let you know when processing is done
    MsgBox "Processing complete! All titles are unique and addresses have been renamed.", vbInformation
End Sub

Step-by-Step Explanation (For Beginners) #

1. Constant Setup #

• DATA_COLUMN: Change this to the letter of the column where your titles are stored (e.g., "C" if they’re in column C).
• START_ROW: Set this to the first row with your data (use 2 if you have a header row at the top).

2. Count Title Occurrences #

We first loop through all rows to count how many times each title appears. This tells us which titles need unique suffixes.

3. Add Unique Suffixes #

We loop through the data again. For titles that appear more than once, we add a sequential number (1, 2, 3...) to make them unique. Titles that only appear once stay unchanged.

4. Rename Addresses #

Finally, we scan for every cell containing "Address". For each one, we grab the title from the row above and rename the cell to [Title] Address (e.g., "Subject Info Address").

How to Use the Code #

1. Open your Excel file with the titles.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook in the Project Explorer (left pane) → Insert → Module.
4. Paste the code above into the new module.
5. Adjust the DATA_COLUMN and START_ROW constants if needed.
6. Press F5 to run the macro, or go back to Excel and run it from the Developer tab → Macros → Select ProcessTitlesAndAddresses → Run.

Why This Works for Large Datasets #

• Dictionaries are used for fast lookups (O(1) time complexity), which keeps the process quick even with 1000+ rows.
• We only loop through the data 3 times total—no nested loops that would slow things down for large files.

内容的提问来源于stack exchange，提问作者isomericharsh