求excel代码: 数据重排和打印解决方案

求excel代码: 数据重排和打印
求excel代码: 数据重排和打印
设工作簿book1中有三个工作表sheet1,sheet2和sheet3
在sheet1中有如下排列的语文成绩,每行是一个学生的

学号语文1 语文2
1001 78 12
1002 56 34
1003 34 56

在sheet2中有如下排列的数学成绩,每行是一个学生的

学号数学1 数学2
1001 1 4
1002 22 55
1003 3 6

求一段VBA代码:
能把某一个学号的学号,语文1, 语文2, 数学1, 数学2分别复制到sheet3的
a1
b1 b2
c1 c2
单元格中
然后设a1:c2为可打印区域,并发出一个打印命令

比如:
如果我选中sheet1中的a3单元格,由于这个单元格中的值是'1001',我一运行这段代码,就在sheet3中形成
1002
56 34
22 55
并设这五个值为打印区域,并发命令打出来,代码最好用循环的方式,以便在以后增加学科后也能运行.
可以考虑改变工作表的名称,以便于编码

------解决方案--------------------
拖了好几天，今天有空花半个小时写完了
打开VBA IDE，新建一个模块，把代码复制进去
这个程序，会把结果固定输出到代码所在文档的Sheet3表单，可以任意增加成绩表单（只要不占用Sheet3就行），甚至增加文档也可以
不过程序没有对各种异常进行处理，例如操作者没有选中学号，也会打印空表单。要处理各种异常的话，代码要增加几倍

VB code

Sub PrintSelected()
    ThisWorkbook.Sheets("Sheet3").Cells.ClearContents
    
    stud = Selection.Value
    ThisWorkbook.Sheets("Sheet3").Cells(1, 1) = stud
    
    n = 2
    For Each sh In ActiveWorkbook.Sheets
        If sh Is ThisWorkbook.Sheets("Sheet3") Then
            Exit For
        End If
        For i = 2 To 65535
            If sh.Cells(i, 1) = "" Then
                Exit For
            End If
            If sh.Cells(i, 1) = stud Then
                sh.Rows(i).Copy
                ThisWorkbook.Sheets("Sheet3").Rows(n).Insert
                n = n + 1
                Exit For
            End If
        Next
    Next
    
    Application.CutCopyMode = False
    ThisWorkbook.Sheets("Sheet3").PrintOut Copies:=1, Collate:=True
End Sub

求excel代码: 数据重排和打印解决方案

相关推荐