前言：
今天各位老铁们对“vba强制转换”大体比较讲究，大家都想要了解一些“vba强制转换”的相关文章。那么小编在网摘上汇集了一些有关“vba强制转换””的相关内容，希望姐妹们能喜欢，小伙伴们一起来学习一下吧！观看视频了解更多
一、问题的提出
学校教务处在编排课程表时，第一步要根据学校对教师工作任务的分配，制作班级任课表（如下图），班级任课表可清晰地呈现各班级、各学科的教师任课情况。
班级任课表
第二步要制作教师任课表，要在《班级任课表》基础上，对全校每位教师担任哪一个班级的哪一门学科进行汇总，既方便教师查询自己的任课情况，也是我们后续编排教师课程表的前提。
教师任课表
当学校教师数量较多时，手动输入制作教师任课表真的是一件费时费力的苦差，我真的不想这么过了，这苦这累成了倒逼我寻找简捷方法的动力。我们研究上述《班级任课表》和《教师任课表》，会发现二者之间是有内在联系的，只不过是信息的呈现方式不一样，完全可以利用《班级任课表》直接转化为《教师任课表》，经过一段时间的探索，我用VBA完成了这个转化，今天，我来分享自己的探索成果，希望能给被同样问题困扰的教务同行有所帮助与启发。
二、问题解决
1、右击《班级任课表》工作表标签，在弹出的快捷菜单中选择"查看代码"命令，在打开的VBA窗口中输入以下代码：
Sub 获取教师唯一姓名()
On Error Resume Next
Application.ScreenUpdating = False
Dim R As Integer, C As Integer, sht As Worksheet
Dim s As String, JsName, JsOnly, h, firstAddress
Dim k As Integer, i As Integer, j As Integer, n As String
Dim strRenKe As String, Rng As Range, bj As String, rk As String
Set mydic = CreateObject("Scripting.Dictionary")
Set sht = Worksheets("班级任课表")
C = sht.Range("A2").End(xlToRight).Column '获取最右一列列号
R = sht.Range("A2").End(xlDown).Row '获取最后一行行号
s = "B4:" & GCB(Val(C)) & R
'获取教师任课数据区域，GCB为自定义函数，用于从列号获取列标
JsName = sht.Range(s).Value '将教师姓名存储在二维数组JsName(k,i)中
s = "B3:" & GCB(Val(C)) & R '查找时向左扩展一行，以便能从B4开始查找
Set Rng = sht.Range(s)
For k = 1 To R - 3 '从B4开始，故数组第一维从1至R－3，减去前3行
For i = 1 To C - 1 '从B4开始，故数组第二维从1至C－1，减去A列
n = Trim(JsName(k, i)) '获取教师姓名，用于查找任课情况
strRenKe = "" '清空教师任课情况，用于循环查找下一位教师任课
If Not mydic.Exists(n) And n <> "" Then '当教师姓名不为空，关键字不存在时
With Rng '对教师区域进行查找
bj = "": rk = ""
Set h = .Find(n)
If Not h Is Nothing Then
firstAddress = h.Address
Do
If Left(bj, 1) = Left(sht.Cells(3, h.Column), 1) And rk = sht.Cells(h.Row, "A") Then
bj = sht.Cells(3, h.Column) '获取班级名称
rk = sht.Cells(h.Row, "A") '获取学科名称
strRenKe = Left(strRenKe, Len(strRenKe) - Len(rk)) & Right(bj, 1) & rk
ElseIf rk = sht.Cells(h.Row, "A") Then
bj = sht.Cells(3, h.Column) '获取班级名称
rk = sht.Cells(h.Row, "A") '获取学科名称
strRenKe = Left(strRenKe, Len(strRenKe) - Len(rk)) & bj & rk
Else
bj = sht.Cells(3, h.Column) '获取班级名称
rk = sht.Cells(h.Row, "A") '获取学科名称
strRenKe = strRenKe & bj & rk
End If
Set h = .FindNext(h)
Loop Until h Is Nothing Or h.Address = firstAddress
End If
End With
mydic.Add n, strRenKe
End If
Next i
Next k
Set sht = Worksheets("教师任课表")
JsOnly = mydic.Keys '获取教师姓名，转置在A列
sht.Range("A2:A" & mydic.Count + 1) = WorksheetFunction.Transpose(JsOnly)
JsOnly = mydic.Items '获取教师任课，转置在B列
sht.Range("B2:B" & mydic.Count + 1) = WorksheetFunction.Transpose(JsOnly)
Set Rng = Nothing: Set sht = Nothing
Application.ScreenUpdating = True
End Sub
2、代码注释
⑴s = "B4:" & GCB(Val(C)) & R
C是获取最右一列列号，这与学校班级数量多少有关，这个C获取的是字符型数字，所以用Val函数才能将字符型数字C，转换成数值型数字。然后利用自定义函数GCB从列号获取列标字母，如37就转换为AK，从而获取教师任课数据区域。
⑵自定义函数GCB代码（这段代码最好放在模块中）
Public Function GCB(Num As Integer) As String
'快速将列标数字转化为列标（如2转化为B，16384转化为XFD等）
Application.ScreenUpdating = False
On Error Resume Next
If Num > 16384 Or Num < 1 Then Exit Function
Dim y As Integer, s As String
s = ""
Do
y = Num Mod 26
If y = 0 Then
s = Chr(64 + 26) & s
Num = Num \ 26 - 1
Else
s = Chr(64 + y) & s
Num = Num \ 26
End If
Loop Until Num = 0
GCB = Trim(s)
Application.ScreenUpdating = True
End Function
⑶Set mydic = CreateObject("Scripting.Dictionary")
用于创建一个字典mydic，利用字典关键字的唯一性，从班级任课表中有重复的教师姓名中获取每位教师姓名的唯一值。
⑷Set h = .Find(n)与Set h = .FindNext(h)
n储存的是一位教师的姓名，根据教师的姓名获取他的所有任课，Find是查找，FindNext是查找下一个直到查找完毕。
⑸Do……Loop循环中的多个If语句，用于处理教师任课中的冗余字符，譬如同一年级名称、同一学科名称只显示一个，这样数据更简洁直观。
⑹WorksheetFunction.Transpose(JsOnly)
JsOnly是储存教师姓名或教师任课的一维数组，对应于工作表中一行数据，要把一行数据转置为一列数据，使用工作表函数之转置函数WorksheetFunction.Transpose。
VBA代码窗口
