求个数据调用代码

779846526

数据调用.zip (316.21 KB, 下载次数: 9)

2019-1-22 08:39 上传

点击文件名下载附件

有一表中要用多个表中的数据，想写个数据调用的代码方便些，麻烦路过的帮忙看下

lsc900707

自己录制宏就可以完成的。

779846526

lsc900707 发表于 2019-1-22 09:36
自己录制宏就可以完成的。

谢谢版主再次回贴，我也试过用录制宏的办法，在调用宏时程序有时运行出错啊

lsc900707

779846526 发表于 2019-1-22 10:40
谢谢版主再次回贴，我也试过用录制宏的办法，在调用宏时程序有时运行出错啊

那就分开copy或者用数组的方法。

不知道为什么

这个应该完全自己可以解决的把

779846526

不知道为什么 发表于 2019-1-22 11:19
这个应该完全自己可以解决的把

本人是菜鸟一个，真不会

lsc900707

779846526 发表于 2019-1-22 10:40
谢谢版主再次回贴，我也试过用录制宏的办法，在调用宏时程序有时运行出错啊

每一列行数不同耶。参考附件：

YZC51

Sub 整理学生课表()
m = [a65536].End(3).Row
arr0 = Sheets("选考数据").Range("a1:c" & m)
Range("A1").Offset(0, 0).Resize(m - 1, 3) = arr0

arr1 = Sheets("第1节").Range("a1:d" & m)
arr2 = Sheets("第2节").Range("a1:d" & m)
arr3 = Sheets("第3节").Range("a1:d" & m)
arr = Array(arr1, arr2, arr3)
    For i = 0 To 8 Step 4
        [a1].CurrentRegion.Sort [c1], 1, , , , , , 1
        [a1].CurrentRegion.Sort Cells(1, i + 5), 1, , , , , , 1
        k = i / 4
        Debug.Print i, k
        Range("D1").Offset(0, i).Resize(m - 1, 4) = arr(k)
    Next
    [a1].CurrentRegion.Sort [a1], 1, , , , , , 1
'    Range("A1:O" & m).Sort Key1:=Range("a2"), Order1:=xlAscending, Header:=xlGuess
End Sub

YZC51

请参考
数据调用.zip (317.94 KB, 下载次数: 4)

2019-1-22 13:13 上传

点击文件名下载附件

lsdongjh

1. 
   
2. Sub Test()
   
3.     Dim shResult As Worksheet, shData As Worksheet
   
4.     Dim arr As Variant, lngRows As Long
   
5.    
   
6.     Set shResult = Sheets("学生课表")
   
7.     shResult.UsedRange.Clear
   
8.     shResult.Range("A1:O1") = Array("学号", "姓名", "班级", "节次", "课程", "班级", "教师", "节次", "课程", "班级", "教师", "节次", "课程", "班级", "教师")
   
9.    
   
10.     Set shData = Sheets("选考数据")
    
11.     lngRows = shData.Range("A" & Rows.Count).End(xlUp).Row
    
12.     arr = shData.Range("A2:C" & lngRows)
    
13.     shResult.Range("A2:C" & lngRows) = arr
    
14.    
    
15.     Set shData = Sheets("表四")
    
16.     arr = shData.Range("B2:D" & lngRows)
    
17.     shResult.Range("E2:E" & lngRows) = Application.WorksheetFunction.Index(arr, 0, 1)
    
18.     shResult.Range("I2:I" & lngRows) = Application.WorksheetFunction.Index(arr, 0, 2)
    
19.     shResult.Range("M2:M" & lngRows) = Application.WorksheetFunction.Index(arr, 0, 3)
    
20.    
    
21.     Set shData = Sheets("第1节")
    
22.     arr = shData.Range("A2:A" & lngRows)
    
23.     shResult.Range("D2:D" & lngRows) = arr
    
24.    
    
25.     Set shData = Sheets("第2节")
    
26.     arr = shData.Range("A2:A" & lngRows)
    
27.     shResult.Range("H2:H" & lngRows) = arr
    
28.    
    
29.     Set shData = Sheets("第3节")
    
30.     arr = shData.Range("A2:A" & lngRows)
    
31.     shResult.Range("L2:L" & lngRows) = arr
    
32. End Sub

复制代码