# Excel判斷 名單整理、彙整

http://attach.mobile01.com/attach/201412/mobile01-...

http://attach.mobile01.com/attach/201412/mobile01-...

http://attach.mobile01.com/attach/201412/mobile01-...

1."飛虎隊"及"老鷹隊"的名單能夠判斷[VIP]、[工作人員]將名單傳送到"總表"上的[VIP]、[工作人員]

2.人數旁邊的數字能依名單個數更動

3.希望名單能五個五個排列，到第六個換下一行

http://www.mobile01.com/attachdl.php?id=53828676&f...

Rating
• 顯栓
Lv 7
6 years ago

http://tco.cseintltd.com.tw/applerot/VBA/list.xls

看一下檔案

2014-12-31 18:29:49 補充：

Private Sub Worksheet_Activate()

Dim Vip(2, 4), Work(2, 4), Nf(2, 4)

Range("A4:E6").ClearContents

Range("A8:E10").ClearContents

Range("A13:E15").ClearContents

SHC = ThisWorkbook.Sheets.Count

For i = 2 To SHC

For Each a In Sheets(i).Range("A4:E6")

If a <> "" Then

j = j + 1

Vip(Int((j - 1) / 5), (j - 1) Mod 5) = a.Value

End If

Next

For Each b In Sheets(i).Range("A8:E10")

If b <> "" Then

k = k + 1

Work(Int((k - 1) / 5), (k - 1) Mod 5) = b.Value

End If

Next

For Each c In Sheets(i).Range("A13:E15")

If c <> "" Then

l = l + 1

Nf(Int((l - 1) / 5), (l - 1) Mod 5) = c.Value

End If

Next

Next

Range("A4").Resize(3, 5) = Vip

Range("A8").Resize(3, 5) = Work

Range("A13").Resize(3, 5) = Nf

End Sub

• 6 years ago

測試成功，已經解決我的問題囉!

非常謝謝

請知識長上答