- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 14
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-6
|
3#
發表於 2015-6-4 00:06
| 只看該作者
回復 2# Farnsworth
有幾點需事先說明的:
1. 因為語系不同的關係,資料中的簡體字會變成?, 導致 .Value= ... 那行會因此無法賦值,故該行我僅能代換成固定的值來做測試.
2. 在 Excel 表格中,除非想指定文字切割位置,否則可以讓 Excel 自己換行,
此處把 (学员信息汇总统计) 工作表中的所有標題文字去除換行字元,方便程式直接取用.
3. 因應上述 2. 的直接取用需求, 你須要修改 (学员信息汇总统计) 工作表中的 G2 儲存格內容 (科目四合格) 為 (科目四合格学员) 方能順利套用.- Sub nn()
- 'G : 科目四合格学员 .Interior.ColorIndex=10 .font.colorindex=-4105
- 'H : 财务室所有交费学员 .Interior.ColorIndex=36 .font.colorindex=41
- 'I : 考试费710总表 .Interior.ColorIndex=47 .font.colorindex=44
- 'J : 学员信息汇总VIP .Interior.ColorIndex=40 .font.colorindex=53
- 'K : 退学C1 .Interior.ColorIndex=36 .font.colorindex=47
- 'L : 学员信息A2B2 .Interior.ColorIndex=6 .font.colorindex=3
- 'M : 退学A2B2 .Interior.ColorIndex=23 .font.colorindex=49
- 'N : 退学VIP .Interior.ColorIndex=4142 .font.colorindex=1
- Dim iCol%
- Dim lRow&
- Dim sStr$
- Dim vD, vInt(), vFnt()
- Dim wsSou As Worksheet, wsTar As Worksheet
-
- Set vD = CreateObject("Scripting.Dictionary")
-
- vInt = Array(10, 36, 47, 40, 36, 6, 23, -4142)
- vFnt = Array(-4105, 41, 44, 53, 47, 3, 49, 1)
-
- Set wsSou = Sheets("学员信息汇总")
- Set wsTar = Sheets("学员信息汇总统计")
-
- lRow = 3
- With wsTar
- .Range(.Rows(3), .Rows(Rows.Count)).Delete
- .Activate
- End With
-
- With wsSou
- While .Cells(lRow, 1) <> ""
- .Range(.Cells(lRow, 1), .Cells(lRow, 6)).Copy wsTar.Cells(lRow, 1)
- vD(.Cells(lRow, 2) & .Cells(lRow, 3)) = lRow
- lRow = lRow + 1
- Wend
- End With
-
- With Sheets("学员信息汇总统计")
- iCol = 7 ' G Column
- Do While .Cells(2, iCol) <> ""
- sStr = .Cells(2, iCol)
- Set wsSou = Sheets(sStr)
- lRow = 2 - (sStr = "学员信息汇总VIP")
- With wsSou
- Do While .Cells(lRow, 1) <> ""
- If vD.Exists(.Cells(lRow, 2) & .Cells(lRow, 3)) Then
- With wsTar.Cells(CInt(vD(.Cells(lRow, 2) & .Cells(lRow, 3))), iCol)
- .Value = wsTar.Cells(CInt(vD(.Cells(lRow, 2) & .Cells(lRow, 3))), 2)
- .Interior.ColorIndex = vInt(iCol - 7)
- With .Font
- .ColorIndex = vFnt(iCol - 7)
- .Bold = True
- End With
- End With
- End If
- lRow = lRow + 1
- Loop
- End With
- iCol = iCol + 1
- Loop
- End With
- End Sub
|
|
