Excel VBA转置数据出现重复条目问题求助

Hey EllieB, let's fix this transposition headache once and for all! As someone who's stumbled through VBA's quirks as a newbie before, I know exactly how frustrating it is to get code running only to hit weird duplication bugs. Let's break this down step by step.

Chances are your original code had a loop logic misstep—maybe you accidentally iterated over rows twice, or didn't set a clear boundary for the last column, leading to repeated writes (especially that extra messy repeat on the final category). Let's replace that with a clean, straightforward approach.

This macro will take your 2-row, 238-column data and turn it into a neat 2-column, 238-row list with zero duplicates:

Sub TransposeCleanly()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastCol As Integer
    Dim i As Integer
    Dim targetRow As Integer
    
    ' Update these sheet names to match your workbook
    Set sourceSheet = ThisWorkbook.Sheets("OriginalData") ' Where your 2-row data lives
    Set targetSheet = ThisWorkbook.Sheets("TransposedList") ' Where we'll output the clean list
    
    ' Dynamically find the last column with data (works even if you have more/less than 238 columns)
    lastCol = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column
    
    ' Start writing results from the first row of the target sheet
    targetRow = 1
    
    ' Loop through each column once—no repeats!
    For i = 1 To lastCol
        ' Write category from source row 1 to target column A
        targetSheet.Cells(targetRow, 1).Value = sourceSheet.Cells(1, i).Value
        ' Write corresponding value from source row 2 to target column B
        targetSheet.Cells(targetRow, 2).Value = sourceSheet.Cells(2, i).Value
        ' Move to the next row for the next pair
        targetRow = targetRow + 1
    Next i
    
    MsgBox "Done! Check " & targetSheet.Name & " for your clean transposed list."
End Sub

Quick breakdown of how this works: #

• We explicitly define where your source data lives and where the result goes (no guessing!)
• The lastCol line automatically finds the end of your data, so you don't have to hardcode 238 (handy if your column count changes later)
• Each column is processed exactly once: one loop iteration = one row in the target sheet. No accidental repeats here.

Now that we have a clean list, let's add code to remove or hide rows where the second column (your corresponding value) is blank. Pick the option that fits your needs:

Option 1: Hide blank rows (reversible) #

This uses Excel's autofilter to hide empty rows without deleting anything:

Sub FilterBlanks()
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("TransposedList")
    
    ' Turn on autofilter if it's not already active
    If Not targetSheet.AutoFilterMode Then
        targetSheet.Range("A1:B1").AutoFilter
    End If
    
    ' Filter column B to show only non-blank values
    targetSheet.Range("A1:B1").AutoFilter Field:=2, Criteria1:="<>"
End Sub

Option 2: Delete blank rows permanently (back up your data first!) #

If you want to remove empty rows entirely, use this (we loop from bottom to top to avoid skipping rows as we delete):

Sub DeleteBlankRows()
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set targetSheet = ThisWorkbook.Sheets("TransposedList")
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "B").End(xlUp).Row
    
    ' Delete from bottom to top to prevent row-skipping bugs
    For i = lastRow To 2 Step -1
        If targetSheet.Cells(i, 2).Value = "" Then
            targetSheet.Rows(i).Delete
        End If
    Next i
End Sub

You can even combine the transposition and filtering into one macro if you want—just paste the filter/delete code right after the Next i line in the first macro.

No more messy duplicates, and you'll have a clean list ready for whatever comes next. Happy coding!

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