|
楼主 |
发表于 2017-10-14 13:39
|
显示全部楼层
将表2所带班级改为任课节数后,将代码稍作修改,修改为下面代码,就可以实现我当初的要求。
不过,还是Micro提供的代码提取后,结果一目了然。非常感谢!
'Write By:Micro,QQ:79833378,微信:dgpigs,Q群:288507620
Sub 调整格式()
Dim vData As Variant, nRow As Integer, nCol As Integer
Dim oDic As Object
Dim sWeek As String, nClass As Integer, nLesson As Integer, sTeacher As String
Dim vFill As Variant
Set oDic = CreateObject("Scripting.Dictionary")
vData = Sheet1.[A19].CurrentRegion.Value
For nCol = 4 To UBound(vData, 2)
If vData(1, nCol) <> "" Then sWeek = Trim(vData(1, nCol))
If vData(2, nCol) <> "" Then nClass = Val(vData(2, nCol))
For nRow = 3 To UBound(vData)
nLesson = Val(vData(nRow, 3))
If vData(nRow, nCol) <> "" Then
sTeacher = Trim(vData(nRow, nCol))
If oDic.Exists(sTeacher & "|" & sWeek & "|" & nClass) Then
oDic(sTeacher & "|" & sWeek & "|" & nClass) = oDic(sTeacher & "|" & sWeek & "|" & nClass) & "," & nLesson
Else
oDic(sTeacher & "|" & sWeek & "|" & nClass) = nLesson
End If
End If
Next
Next
vData1 = Sheet3.UsedRange.Value
ReDim vFill(3 To UBound(vData1), 3 To UBound(vData1, 2))
For nCol = 3 To UBound(vData1, 2)
If vData(2, nCol) <> "" Then nClass = Val(vData(2, nCol))
If vData1(2, nCol) <> "" Then
sWeek = Trim(vData1(2, nCol))
nClass = 1
Else
nClass = nClass + 1
End If
For nRow = 3 To UBound(vData1)
sTeacher = Trim(vData1(nRow, 1))
If oDic.Exists(sTeacher & "|" & sWeek & "|" & nClass) Then
vFill(nRow, nCol) = oDic(sTeacher & "|" & sWeek & "|" & nClass)
End If
Next
Next
Sheet3.[C3].Resize(UBound(vFill) - 2, UBound(vFill, 2) - 2) = vFill
End Sub |
|