[發問] 学员信息比对与显示

Farnsworth

下載 (48.62 KB)

2015-6-3 15:38

这是最初的表格

Farnsworth

回復 1# Farnsworth

由于超过时限不能再编辑了，版面可能说的不是很清楚，要求及说明请各位看附件，感谢！

luhpro

回復 2# Farnsworth
有幾點需事先說明的:
1. 因為語系不同的關係,資料中的簡體字會變成?, 導致 .Value= ... 那行會因此無法賦值,故該行我僅能代換成固定的值來做測試.
2. 在 Excel 表格中,除非想指定文字切割位置,否則可以讓 Excel 自己換行,
   此處把 (学员信息汇总统计) 工作表中的所有標題文字去除換行字元,方便程式直接取用.
3. 因應上述 2. 的直接取用需求, 你須要修改 (学员信息汇总统计) 工作表中的 G2 儲存格內容 (科目四合格) 為 (科目四合格学员) 方能順利套用.

1. Sub nn()
   
2. 'G : 科目四合格学员     .Interior.ColorIndex=10 .font.colorindex=-4105
   
3. 'H : 财务室所有交费学员 .Interior.ColorIndex=36 .font.colorindex=41
   
4. 'I : 考试费710总表      .Interior.ColorIndex=47 .font.colorindex=44
   
5. 'J : 学员信息汇总VIP    .Interior.ColorIndex=40 .font.colorindex=53
   
6. 'K : 退学C1             .Interior.ColorIndex=36 .font.colorindex=47
   
7. 'L : 学员信息A2B2       .Interior.ColorIndex=6  .font.colorindex=3
   
8. 'M : 退学A2B2           .Interior.ColorIndex=23 .font.colorindex=49
   
9. 'N : 退学VIP            .Interior.ColorIndex=4142 .font.colorindex=1
   
10. 
    
11.   Dim iCol%
    
12.   Dim lRow&
    
13.   Dim sStr$
    
14.   Dim vD, vInt(), vFnt()
    
15.   Dim wsSou As Worksheet, wsTar As Worksheet
    
16.   
    
17.   Set vD = CreateObject("Scripting.Dictionary")
    
18.   
    
19.   vInt = Array(10, 36, 47, 40, 36, 6, 23, -4142)
    
20.   vFnt = Array(-4105, 41, 44, 53, 47, 3, 49, 1)
    
21.   
    
22.   Set wsSou = Sheets("学员信息汇总")
    
23.   Set wsTar = Sheets("学员信息汇总统计")
    
24.   
    
25.   lRow = 3
    
26.   With wsTar
    
27.     .Range(.Rows(3), .Rows(Rows.Count)).Delete
    
28.     .Activate
    
29.   End With
    
30.   
    
31.   With wsSou
    
32.     While .Cells(lRow, 1) <> ""
    
33.       .Range(.Cells(lRow, 1), .Cells(lRow, 6)).Copy wsTar.Cells(lRow, 1)
    
34.       vD(.Cells(lRow, 2) & .Cells(lRow, 3)) = lRow
    
35.       lRow = lRow + 1
    
36.     Wend
    
37.   End With
    
38.   
    
39.   With Sheets("学员信息汇总统计")
    
40.     iCol = 7  ' G Column
    
41.     Do While .Cells(2, iCol) <> ""
    
42.       sStr = .Cells(2, iCol)
    
43.       Set wsSou = Sheets(sStr)
    
44.       lRow = 2 - (sStr = "学员信息汇总VIP")
    
45.       With wsSou
    
46.         Do While .Cells(lRow, 1) <> ""
    
47.           If vD.Exists(.Cells(lRow, 2) & .Cells(lRow, 3)) Then
    
48.             With wsTar.Cells(CInt(vD(.Cells(lRow, 2) & .Cells(lRow, 3))), iCol)
    
49.               .Value = wsTar.Cells(CInt(vD(.Cells(lRow, 2) & .Cells(lRow, 3))), 2)
    
50.               .Interior.ColorIndex = vInt(iCol - 7)
    
51.               With .Font
    
52.                 .ColorIndex = vFnt(iCol - 7)
    
53.                 .Bold = True
    
54.               End With
    
55.             End With
    
56.           End If
    
57.           lRow = lRow + 1
    
58.         Loop
    
59.       End With
    
60.       iCol = iCol + 1
    
61.     Loop
    
62.   End With
    
63. End Sub

複製代碼

Farnsworth

回復 3# luhpro
非常感谢您的解答，正在测试，不合适的地方我再联系您。

1. 因為語系不同的關係,資料中的簡體字會變成?, 導致 .Value= ... 那行會因此無法賦值,故該行我僅能代換成固定的值來做測試.

看过你上面第一条说明，在程序使用中我应该怎

Farnsworth

回復 3# luhpro

下載 (4.15 KB)

2015-6-4 10:33

看过您这句：1. 因為語系不同的關係,資料中的簡體字會變成?, 導致 .Value= ... 那行會因此無法賦值,故該行我僅能代換成固定的值來做測試.
就是不知道这段代码应该改成什么内容，请指教，感谢！！！

luhpro

回復  luhpro

看过您这句：1. 因為語系不同的關係,資料中的簡體字會變成?, 導致 .Value= ...
Farnsworth 發表於 2015-6-4 10:35

原則上應該是不用改的,
那句話的意思是我不能直接以你提供的簡體字資料來做測試.

通常我給的程式都會以樓主所提供的資料實際做過測試,
確認可以達到我理解後的樓主需求才會貼上來,
除非實在是時間上來不及完成測試.

而因為此例有語系上不同的緣故,
執行你提供的資料會發生錯誤,
故而該行我只能另用固定資料做代換, (例如 : 123)
以便程式能順利執行完畢,
故而除該行執行結果未能完成測試外,
其餘已儘量測試完成.

Farnsworth

回復 6# luhpro

能不能按照您的想法，你可以把所有的简体名称资料都改成你所需要的，且运行正确，做一份发我邮箱（wxb120205@msn.com），我真的做不来的，求您了，再次感谢！！！

Farnsworth

回復 6# luhpro

您好，又要麻烦您，能不能做一份你运行正确的文档给我看看。你的程序式如果有几万行学员，运行起来就死机，在我这边一直没测试通过。

luhpro

回復  luhpro

您好，又要麻烦您，能不能做一份你运行正确的文档给我看看。你的 ...
Farnsworth 發表於 2015-6-7 10:49

你要先把裡面那一堆公式全部刪掉,
不然程式運行時一直重新計算幾乎保證死機,
或者要先把運算模式改成手動,並取消勾選儲存前自動重算.

另外公式修改一行:

.Value = wsTar.Cells(CInt(vD(wsSou.Cells(lRow, 2) & wsSou.Cells(lRow, 3))), 2)

學員訊息比對與顯示.zip (194.89 KB)

下載次數: 1

2015-6-9 01:04