Excel中同一索赔的多行CPT码转单行多列（最多30列）的实现方法咨询

My excel file has 213,262 records - approximately 43k claims. There are multiple CPT codes for each claim listed in a single column. I need to convert each claim to 1 row with multiple columns, a column for each CPT code. The number of codes vary for each claim but I only want to see a max of 30 CPT codes.

Right now, my data looks like this:

Item #	CPT
123456789	11111
123456789	22222
123456789	33333
123456789	44444

I need it to be:

Item #	CPT1	CPT2	CPT3	CPT4
123456789	11111	22222	33333	44444

Any help or suggestions would be greatly appreciated! Thanks in advance!

嗨，Christy，针对你这个处理大量CPT码转置的需求，我整理了几个高效的解决方案，适配你20多万条记录的场景：

方法一：Power Query（首推，大数据量友好） #

Power Query是Excel自带的工具，处理几十万条数据毫无压力，步骤清晰易操作：

1. 选中你的原始数据区域（包含Item #和CPT表头），点击数据选项卡 → 从表格/区域，弹窗里确认勾选「我的表格有标题」后进入编辑器。
2. 在编辑器中选中CPT列，点击转换选项卡 → 透视列。
3. 弹出的设置框里：
   • 值列选择CPT
   • 高级选项选择「不要聚合」，点击确定。
4. 此时每个Item #对应的CPT会自动拆分成CPT.1、CPT.2…这样的列，你可以批量重命名为CPT1、CPT2…
5. 点击主页 → 关闭并上载，处理好的数据会导出到新工作表。
6. 如果有Item #的CPT超过30个，直接选中第31列及以后的列右键删除即可。

方法二：数组公式（无需工具，手动实现） #

如果你暂时不想用Power Query，可以用数组公式来实现：
假设原始数据在Sheet1，A列是Item #，B列是CPT，在新工作表操作：

1. 先提取所有唯一的Item #列表（可以用「数据」→「删除重复项」完成）。
2. 在新表B2单元格输入公式：

   =IFERROR(INDEX(Sheet1!$B:$B,SMALL(IF(Sheet1!$A:$A=$A2,ROW(Sheet1!$A:$A)),COLUMN(A:A))),"")
   

   输入完后按Ctrl+Shift+Enter（Excel 365/2021版本直接回车即可，支持动态数组）。
3. 把B2的公式向右拖动到AD列（对应30个CPT列），再向下拖动到所有Item #行，超出30个的CPT会自动显示为空。

方法三：VBA脚本（自动化批量处理） #

如果需要重复处理这类数据，可以写个VBA宏一键完成：

1. 按Alt+F11打开VBA编辑器，右键左侧的VBAProject → 插入 → 模块。
2. 粘贴以下代码，记得把代码里的Sheet1改成你原始数据的工作表名：

   Sub TransposeCPTCodes()
       Dim wsSource As Worksheet, wsDest As Worksheet
       Dim lastRow As Long, i As Long, j As Long, currentItem As String
       Dim cptCount As Integer
       
       ' 替换为你的原始数据工作表名称
       Set wsSource = ThisWorkbook.Sheets("Sheet1")
       ' 创建新工作表存放结果
       Set wsDest = ThisWorkbook.Sheets.Add
       wsDest.Name = "CPT_Transposed"
       
       ' 写入表头
       wsDest.Range("A1").Value = "Item #"
       For j = 1 To 30
           wsDest.Cells(1, j + 1).Value = "CPT" & j
       Next j
       
       lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
       currentItem = wsSource.Range("A2").Value
       ' 写入第一个Item#
       wsDest.Range("A2").Value = currentItem
       i = 2
       cptCount = 1
       
       Do While i <= lastRow
           If wsSource.Range("A" & i).Value = currentItem Then
               ' 只保留最多30个CPT码
               If cptCount <= 30 Then
                   wsDest.Cells(2, cptCount + 1).Value = wsSource.Range("B" & i).Value
                   cptCount = cptCount + 1
               End If
           Else
               currentItem = wsSource.Range("A" & i).Value
               ' 切换到下一个Item#
               wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = currentItem
               cptCount = 1
               If cptCount <= 30 Then
                   wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(0, cptCount).Value = wsSource.Range("B" & i).Value
                   cptCount = cptCount + 1
               End If
           End If
           i = i + 1
       Loop
       
       MsgBox "处理完成！结果已保存到「CPT_Transposed」工作表。"
   End Sub
   

3. 按F5运行宏，脚本会自动完成转置并只保留最多30列CPT，结果存放在新工作表里。

备注：内容来源于stack exchange，提问作者Christy Weber