从源表中读取固定信息

黄水平

年份        物品编号        物品名称        规格型号        单位        参考单价        配备标准        库存数量
这是源表sheets("小学数学")，源表中从第4行起记录不同年份的小学数学所有仪器，每一年都是按相同的物品编号先后顺序记录的。每个相同物品编号有库存数量上的不同，其余各列每年信息都是一样的。现在我想根据源表得到一个新表。年份  物品编号        物品名称        规格型号        单位        参考单价        配备标准        增加数量 减少数量 这分别是新表列标题。实现的功能：1、源表的第一年的所有行的数据记录前8列复制到新表的前8列，源表中第一年有多少行数据，新表就有多少行数据。在新表从第二行开始记录，第一行为列标题行（原表列“库存数量”到新表叫“增加数量”）新表中第一年数据只有8列。2、从第二年起每一物品编号的库存数量要与上一年的库存数量比较，比上一年库存数量有增减的所在记录行的数据前7列复制到新表，接着已有的新表末行的下一行开始存放，是增加的把增加值写入复制过来的对应行的第8列，是减少的把减少值写在复制过来的对应行的第9列。源表中相邻年份同一物品编号的库存数量相同的不复制。第三年的物品的库存数量与对应的第二年的库存数量比较，以此类推。3、在新表中记录行的顺序是源表中第一年的所有物品记录数据行；第二年比第一年库存数量有增加的数据行，第二年比第一年库存数量有减少的数据行；第三年比第二年库存数量增加的数据行，第三年比第二年库存数量有减少的数据行；以此类推，至到源表中的相邻年份的同一物品比较完成。用excelvba宏代码实现。提示，年份列是用数字表示的（如2015、2016、2017等），每个物品相邻年份相隔的行数相同，每年的数据都是按物品编号排序的。新表中从第二年起记录是库存数量与上一年的增减情况。向各位大神求助！

3190496160

说明很详细，但是缺少最关键的东西——附件，上传附件才可能得到别人的帮助

黄水平

3190496160 发表于 2023-5-3 16:07
说明很详细，但是缺少最关键的东西——附件，上传附件才可能得到别人的帮助

获取数据.zip (106.37 KB, 下载次数: 10)

2023-5-3 19:37 上传

点击文件名下载附件

shiruiqiang

大哥，你至少传个3年的数据吧

3190496160

基本上看明白了，工作量不小，

黄水平

3190496160 发表于 2023-5-4 15:14
基本上看明白了，工作量不小，

有劳了，不愖感激。我这里有一段代码，搞来搞去都是错的，结果是把整个表复制过去了，不知道哪里出了问题。
Sub GenerateNewTable()
Dim srcSheet As Worksheet, destSheet As Worksheet
Dim srcLastRow As Long, destLastRow As Long
Dim srcYear As Integer, destYear As Integer
Dim srcItemNum As String, destItemNum As String
Dim srcStockQty As Double, destStockQty As Double
Dim changeQty As Double

'源表与新表
Set srcSheet = ThisWorkbook.Sheets("小学数学")
Set destSheet = ThisWorkbook.Sheets.Add(After:=srcSheet)
destSheet.name = "增减记录"

' 新表第一行列标题
destSheet.Cells(1, 1) = "年份"
destSheet.Cells(1, 2) = "物品编号"
destSheet.Cells(1, 3) = "物品名称"
destSheet.Cells(1, 4) = "规格型号"
destSheet.Cells(1, 5) = "单位"
destSheet.Cells(1, 6) = "参考单价"
destSheet.Cells(1, 7) = "配备标准"
destSheet.Cells(1, 8) = "增加数量"
destSheet.Cells(1, 9) = "减少数量"

'源表与新表遍历
srcLastRow = srcSheet.Cells(Rows.count, 1).End(xlUp).Row
destLastRow = 1
For i = 4 To srcLastRow
    srcYear = srcSheet.Cells(i, 1)
    srcItemNum = srcSheet.Cells(i, 2)
    srcStockQty = srcSheet.Cells(i, 8)

    If i = 4 Or (srcItemNum <> prevItemNum) Then
        destLastRow = destLastRow + 1
        destYear = srcYear
        destItemNum = srcItemNum
        destStockQty = srcStockQty

        destSheet.Cells(destLastRow, 1) = destYear
        destSheet.Cells(destLastRow, 2) = destItemNum
        destSheet.Cells(destLastRow, 3) = srcSheet.Cells(i, 3)
        destSheet.Cells(destLastRow, 4) = srcSheet.Cells(i, 4)
        destSheet.Cells(destLastRow, 5) = srcSheet.Cells(i, 5)
        destSheet.Cells(destLastRow, 6) = srcSheet.Cells(i, 6)
        destSheet.Cells(destLastRow, 7) = srcSheet.Cells(i, 7)
    Else
        changeQty = srcStockQty - destStockQty

        If changeQty > 0 Then
            destLastRow = destLastRow + 1
            destYear = srcYear
            destStockQty = srcStockQty

            destSheet.Cells(destLastRow, 1) = destYear
            destSheet.Cells(destLastRow, 2) = destItemNum
            destSheet.Cells(destLastRow, 3) = srcSheet.Cells(i, 3)
            destSheet.Cells(destLastRow, 4) = srcSheet.Cells(i, 4)
            destSheet.Cells(destLastRow, 5) = srcSheet.Cells(i, 5)
            destSheet.Cells(destLastRow, 6) = srcSheet.Cells(i, 6)
            destSheet.Cells(destLastRow, 7) = srcSheet.Cells(i, 7)
            destSheet.Cells(destLastRow, 8) = changeQty
        ElseIf changeQty < 0 Then
            destLastRow = destLastRow + 1
            destYear = srcYear
            destStockQty = srcStockQty

            destSheet.Cells(destLastRow, 1) = destYear
            destSheet.Cells(destLastRow, 2) = destItemNum
            destSheet.Cells(destLastRow, 3) = srcSheet.Cells(i, 3)
            destSheet.Cells(destLastRow, 4) = srcSheet.Cells(i, 4)
            destSheet.Cells(destLastRow, 5) = srcSheet.Cells(i, 5)
            destSheet.Cells(destLastRow, 6) = srcSheet.Cells(i, 6)
            destSheet.Cells(destLastRow, 7) = srcSheet.Cells(i, 7)
            destSheet.Cells(destLastRow, 9) = -changeQty
        End If
    End If

    prevItemNum = srcItemNum
Next i

End Sub

3190496160

论坛只能解决一般性问题，毕竟大家都是一种业余爱好而已，