求助各位老师帮忙整理一下表格数据

mx36771

由表一整理成表二的样子
最好是在表一完成，顺便写一下每行代码的说明，新手想学习~
谢谢各位老师

wang-way

每行写说明可以交给ai

timmessiah

Sub OrganizeData()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long
    Dim currentSequence As Long
    Dim currentValue As String
    Dim previousValue As String
   
    ' 使用工作表编号
    Set ws = ThisWorkbook.Sheets(1)

    ' 找到最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
   
    ' 找到最后一列
    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column

    ' 对整表按A列和B列进行排序
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(3, 1), ws.Cells(lastRow, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(3, 2), ws.Cells(lastRow, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)) ' 包括所有行
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' 在B列右侧增加两列空列
    ws.Range(ws.Cells(1, 3), ws.Cells(lastRow, 4)).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    ' 初始化变量
    currentSequence = 0
    previousValue = ""

    ' 遍历第三行到最后一行的数据
    For i = 3 To lastRow
        currentValue = ws.Cells(i, 2).Value  ' B列的值

        ' 若当前值与前一个值不同，重新开始排序
        If currentValue <> previousValue Then
            currentSequence = 1
        Else
            currentSequence = currentSequence + 1
        End If

        ' 在D列填充顺序号
        ws.Cells(i, 4).Value = currentSequence

        ' 在C列填充B列的值、"-"和顺序号
        ws.Cells(i, 3).Value = currentValue & "-" & currentSequence

        ' 更新前一个值
        previousValue = currentValue
    Next i
End Sub

dambcer

也可以把钱交给我，我把注释交给你

蓝桥玄霜

整理的例子：

usedrange

1. Sub t()
   
2.     Dim m%, co%, i%, j%, n%
   
3.     With Sheets("原表")
   
4.         m = .Cells(2, 3).End(4).Row     '获取原表的数据记录的最大行号
   
5. 
   
6.         s = .Columns(3).Insert()    '插入2列空白列
   
7.         s = .Columns(3).Insert()
   
8.         n = 1   '每个单号的计数变量
   
9.         .Cells(2, 3) = "对账单号": .Cells(2, 4) = "序号"    '输入标题
   
10.         For j = 3 To m
    
11.             If .Cells(j, "b") = .Cells(j + 1, "b") Then     '比较第三行单号与下一行单号是否相等，如果相等把2行记录加入计数值n放到c列
    
12.                 .Cells(j, "c") = .Cells(j, "b") & "-" & n
    
13.                 .Cells(j + 1, "c") = .Cells(j, "b") & "-" & n
    
14.                 .Cells(j, "d") = n  '在d列放入计数值
    
15.                 n = n + 1
    
16.             Else
    
17.                 .Cells(j, "c") = .Cells(j, "b") & "-" & n   '当前行的单号与下一行单号不相等时，前一行还是记录之前的值
    
18.                 .Cells(j, "d") = n
    
19.                 If j = m Then Exit For      '当系统运行到最后一行时，退出for循环
    
20.                 n = 1       '计数变量重置为1
    
21.                 .Cells(j + 1, "c") = .Cells(j, "b") & "-" & n   '当前行的单号与下一行单号不相等时，下一行使用重置后的n变量值为1
    
22.                 .Cells(j + 1, "d") = n
    
23.             End If
    
24.         Next j
    
25.     End With
    
26. End Sub

复制代码

LIUZHU

其实，就是一个字典计数问题

LIUZHU

参与下，执行效果

LIUZHU

JS代码，比VBA简单多了

1. function 整理(){
   
2.         let res=Sheets.Item("原表").UsedRange.Value2.slice(2).map(function(x){
   
3.                 this[x[1]]=(this[x[1]] || 0) + 1;
   
4.                 return x.splice(2, 0, `${x[1]}-${this[x[1]]}`, this[x[1]]), x;
   
5.         },{});
   
6.         Sheets.Item("整理").Range("a3").Resize(res.length, res[0].length).Value2=res;
   
7. }

复制代码

LIUZHU

附件，WPS打开测试，运行JS宏