|
- Sub 从表A填入表B()
- Dim sh, i, j, R, MyPath, MyName
- Dim arr(), brr() '数组
- MyPath = ThisWorkbook.Path & ""
- MyName = "A.xlsm" '文件名A
-
- With Workbooks.Open(MyPath & MyName) '打开A簿并复制数据,关闭并不保存
- sh = "2019"
- R = .Sheets(sh).Range("J65536").End(xlUp).Row
- arr = .Sheets(sh).Range("A1:J" & R).Value
- .Close False
- End With
- sh = "成绩录入" '获取B簿K姓名
- R = ThisWorkbook.Sheets(sh).Range("K65536").End(xlUp).Row
- brr = ThisWorkbook.Sheets(sh).Range("K2:N" & R).Value
- For j = 1 To UBound(brr) '对比姓名,匹配则复制数据
- For i = 1 To UBound(arr)
- If brr(j, 1) = arr(i, 10) Then
- brr(j, 2) = arr(i, 3)
- brr(j, 3) = arr(i, 4)
- brr(j, 4) = arr(i, 5)
- arr(i, 10) = ""
- End If
- Next
- Next
- ThisWorkbook.Sheets(sh).Range("K2:N" & R) = brr '数据填到已有姓名对应行
- For i = 1 To UBound(arr) '补充其他姓名及数据
- If arr(i, 10) <> "" Then
- R = R + 1
- ThisWorkbook.Sheets(sh).Cells(R, 11) = arr(i, 10)
- ThisWorkbook.Sheets(sh).Cells(R, 11).Font.ColorIndex = 3 '姓名标红
- ThisWorkbook.Sheets(sh).Cells(R, 12) = arr(i, 3)
- ThisWorkbook.Sheets(sh).Cells(R, 13) = arr(i, 4)
- ThisWorkbook.Sheets(sh).Cells(R, 14) = arr(i, 5)
- End If
- Next
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|