返回列表 上一主題 發帖

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

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-6-3 15:44 | 只看該作者

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

本帖最後由 Farnsworth 於 2015-6-3 15:46 編輯



这是最初的表格

2.png (94.07 KB)

2.png

3.png (109.75 KB)

3.png

4.png (141.8 KB)

4.png

??信息比?与?示.zip (956.13 KB)

收藏 分享

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
2#
發表於 2015-6-3 15:49 | 只看該作者
回復 1# Farnsworth

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

TOP

luhpro

帖子
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 儲存格內容 (科目四合格) 為 (科目四合格学员) 方能順利套用.
  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

  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
複製代碼

TOP

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
4#
發表於 2015-6-4 09:41 | 只看該作者
回復 3# luhpro
非常感谢您的解答，正在测试，不合适的地方我再联系您。

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

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

TOP

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
5#
發表於 2015-6-4 10:35 | 只看該作者
回復 3# luhpro


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

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
14  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-6 
6#
發表於 2015-6-5 23:14 | 只看該作者
回復  luhpro

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

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

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

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

TOP

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
7#
發表於 2015-6-6 17:52 | 只看該作者
本帖最後由 Farnsworth 於 2015-6-6 17:54 編輯

回復 6# luhpro

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

TOP

Farnsworth

帖子
50 
主題
9 
精華
0 
積分
65 
點名
1  
作業系統
WIN10 
軟體版本
OFFICE2016 
閱讀權限
20 
註冊時間
2015-6-2 
最後登錄
2024-11-1 
8#
發表於 2015-6-7 10:49 | 只看該作者
回復 6# luhpro

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

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
14  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-6 
9#
發表於 2015-6-9 01:05 | 只看該作者
回復  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)

TOP

        靜思自在 : 有心就有福，有願就有力，自造福田，自得福緣。
返回列表 上一主題