麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 怎麼在USERFORM中加入可篩選複選之樹狀圖 [打印本頁]

作者: chaoyiho 時間: 2016-4-19 10:50 標題: 怎麼在USERFORM中加入可篩選複選之樹狀圖

各位前輩好~
小弟想問一下關於樹狀圖的問題
如下圖(1)
[attach]23901[/attach]
這是我的表單處理介面
我想要在右方篩選船舶的地方加入樹狀圖，對我輸紐分析後的標籤列做VSL的篩選，並且可以做複選動作
如下圖(2) 為我輸紐過後之檔案，我想在USERFORM內加入篩選樹狀圖如圖(3)最後變成圖(4)的樣子
[attach]23902[/attach]
[attach]23903[/attach]
[attach]23904[/attach]

請問各位前輩
我應該要如何做呢?
目前公司電腦無法壓縮檔案故無法上傳檔案提供各位前輩測試稍後補上:dizzy:

作者: chaoyiho 時間: 2016-4-19 11:18

回復 1# chaoyiho

這是我寫的VBA
[attach]23905[/attach]

這是測試檔案(請選擇165表單)
[attach]23906[/attach]

拜託大家了~~~~!!!!

作者: luhpro 時間: 2016-4-19 22:58

回復 2# chaoyiho

===Module===

Public vD
Option Explicit
...

複製代碼

Private Sub Workbook_Open()
Set vD = CreateObject("Scripting.Dictionary")
EXCEL表單處理介面.Show vbModeless
End Sub

複製代碼

Private Sub CommandButton1_Click()
If Application.FindFile = False Then
MsgBox "您沒有開啟母檔"
End If
Dim lRow&
lRow = 3
vD.RemoveAll
While Cells(lRow, 1) <> ""
If Not vD.Exists(CStr(Cells(lRow, 1))) Then
EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lRow, 1))
vD(CStr(Cells(lRow, 1))) = lRow
End If
lRow = lRow + 1
Wend
End Sub

複製代碼

因為時間上來不及, 這裡只做加到 ListBox 的方法,
你可以參照改成動態新增為你要的 CheckBox 元件.

[attach]23915[/attach]

作者: chaoyiho 時間: 2016-4-21 09:01

回復 3# luhpro
請問前輩
我按照您的指示去做練習之後
發現
他的vD.RemoveAll常常都會出現錯誤訊息
"需要物件"或是"未定義"
而無法運行
請問這樣子是要怎麼解決呢?
還煩請幫忙!!
[attach]23920[/attach]

作者: chaoyiho 時間: 2016-4-22 08:41

前輩您可能在忙所以沒有辦法幫我解答..
可是我真的很想知道!
不知道有沒有人可以替我解答呢?

作者: jackyq 時間: 2016-4-22 10:08

大大可能在 module 漏寫 Public vD ???

作者: c_c_lai 時間: 2016-4-22 10:16

回復 5# chaoyiho
[attach]23925[/attach]

作者: chaoyiho 時間: 2016-4-22 13:43

回復 6# jackyq

前輩好，我有在模組1裡面寫入宣告Public vD

但是一旦執行分析
但是還是出現需要物件
真的不知道怎麼辦 Q_Q

作者: chaoyiho 時間: 2016-4-22 13:44

回復 7# c_c_lai

謝謝前輩提醒，我一直都有加入
但是還是持續出現找不到物件(按下分析之後)
就會跳出錯誤424
到底怎麼會這樣?(崩潰)

作者: jackyq 時間: 2016-4-22 14:11

  Public vD  as object
'
Private Sub CommandButton1_Click()
      If Application.FindFile = False Then
         MsgBox "您沒有開啟母檔"
      End If

      Dim lRow&

   if vD is nothing then  Set vD = CreateObject("Scripting.Dictionary")
      lRow = 3
      vD.RemoveAll
      While Cells(lRow, 1) <> ""
      If Not vD.Exists(CStr(Cells(lRow, 1))) Then
         EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lRow, 1))
         vD(CStr(Cells(lRow, 1))) = lRow
      End If
      lRow = lRow + 1
      Wend
End Sub

作者: c_c_lai 時間: 2016-4-22 16:07

回復 9# chaoyiho
[attach]23932[/attach]
你在模組1 (Module1) 加入了 Public vD
的宣告後，並於 Workbook_Open() 裡
設定了 vD 的屬性，基本上便 OK 了。
往後程式碼之執行均能自動辨認它了。

作者: c_c_lai 時間: 2016-4-22 17:05

回復 9# chaoyiho
我使用 DEBUG MODE 觀察，會產生找不到物件的事實，
故修改成如下：
[attach]23933[/attach]
試試看！

作者: luhpro 時間: 2016-4-22 23:32

本帖最後由 luhpro 於 2016-4-22 23:35 編輯

回復 9# chaoyiho
抱歉,現在才有時間回文.

我之所以會把 vD 的定義放在 Module 上,
原先的構想是資料檔案就那一個,
那麼開始時就讀取一次,
字典建好後面只要拿來用就好了,
不用每按一次按鈕就又要重新讀取檔案及建立對應資料.

習慣性的點兩下 "開啟舊檔" 按鈕開啟 CommandButton1_Click 實做自己的構想,
因為回文後才發現處理 "您沒有開啟母檔" 的 Sub 有好幾個,  O.O"
怕會與之前結果重疊才會加那一行消除前手.

至於你發生的問題,
我在這兩個檔案間操作並不會發生,
因為 RemoveAll 只清除 Key 與資料間的對應關係,
並不會刪除 vD 字典物件.
研判可能是操作中程式先後順序問題,
導致你沒有執行到  Set vD = CreateObject("Scripting.Dictionary").

而關於問題的處理:
在 10# 的是一種簡單明瞭的處理方法.
不過依個人之前的經驗,
也有可能是個人功力太差,
我發現 Excel 上並不能用一個 Is Nothing 就包辦所有這類物件錯誤的判斷,
因為這一行指令也可能會出現錯誤(因為連 vD 這個物件都不能出現在判斷式中)

另有一個很多人使用的處理方法,
就是一開始就加個 On Error Resume Next,
這樣遇到錯誤就當做沒問題發生繼續跑下去,
運氣好就沒事...
但要是運氣不好的話...

比較正統且不易出現非預期結果的做法是針對錯誤做專門的處理. (請搜尋 On Error 陳述式的說明)

Sub ChkFile()
...
On Error GoTo ErrorHandler ' 開啟錯誤處理程式。
vD.RemoveAll ' 發生錯誤需做處理的程式
On Error Goto 0 ' 關閉錯誤處理程式。
...
Exit Sub       ' 離開程式，以避免進入錯誤處理程式。

ErrorHandler: ' 錯誤處理程式。
Select Case Err.Number ' 檢查錯誤代碼。
      Case 424 ' 發生「此處需要物件」之錯誤。
         Set vD = CreateObject("Scripting.Dictionary") ' 建立物件。(針對錯誤發生原因做補救或處理)

      Case Else ' 用 Err.number 取得錯誤代碼, 用 Err.Description 取得錯誤說明文字. Err.Clear 清除錯誤旗標
         MsgBox Prompt:=Err.Description, Buttons:=vbOK, Title:="發生錯誤"
         Err.Clear
         Exit Sub
End Select
Resume ' 將程式執行步驟回到原發生錯誤的陳述式中。
End Sub

另外, 針對重複且可替代的程序建議另建立副程式以供呼叫, 如:
Image22_Click
Image3_Click
Image32_Click()
CommandButton1_Click()
CommandButton10_Click()
CommandButton14_Click()
CommandButton6_Click()
的內容全部都是 :

If Application.FindFile = False Then
      MsgBox "您沒有開啟母檔"
End If

那就可以把這段歸到 Module 內, 設為 Public, 再個別放入呼叫指令即可.
好處是程式碼容易修改與管理, 縮短程式碼, 辨識度也較好.

Public Sub ChkFile()
If Application.FindFile = False Then
MsgBox "您沒有開啟母檔"
End If
Dim lRow&
lRow = 3
On Error GoTo ErrorHandler ' 開啟錯誤處理程式。
vD.RemoveAll
EXCEL表單處理介面.ListBox1.Clear ' 清除 ListBox 的選單
On Error GoTo 0 ' 關閉錯誤處理程式。
While Cells(lRow, 1) <> ""
If Not vD.Exists(CStr(Cells(lRow, 1))) Then
EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lRow, 1))
vD(CStr(Cells(lRow, 1))) = lRow
End If
lRow = lRow + 1
Wend
Exit Sub ' 離開程式，以避免進入錯誤處理程式。
ErrorHandler: ' 錯誤處理程式。
Select Case Err.Number ' 檢查錯誤代碼。
Case 424 ' 發生「此處需要物件」之錯誤。
Set vD = CreateObject("Scripting.Dictionary") ' 建立物件。
Case Else ' 可用 Err.number 取得錯誤代碼, 用 Err.Description 取得錯誤說明文字. Err.Clear 清除錯誤旗標
MsgBox prompt:="錯誤代碼 : " & Err.Number & Chr(10) & "錯誤原因:" & Err.Description, Buttons:=vbOK, Title:="發生錯誤"
Err.Clear
Exit Sub
End Select
Resume ' 將程式執行步驟回到原發生錯誤的陳述式中。
End Sub

複製代碼

Private Sub CommandButton1_Click()
ChkFile
End Sub

複製代碼

餘類推.

[attach]23939[/attach]

作者: jackyq 時間: 2016-4-23 01:20

回復 13# luhpro

大大說的 "我發現 Excel 上並不能用一個 Is Nothing 就包辦所有這類物件錯誤的判斷"

如果把 Public vD  改成 Public vD  as object

還會出現  Is Nothing  發生問題嗎

蠻好奇的

如果是用 Public vD
不用 On Err 可以寫成
if  isObject( vD )  then
if vD  is Nothing  then
end if
end if

作者: GBKEE 時間: 2016-4-23 07:25

本帖最後由 GBKEE 於 2016-4-23 07:31 編輯

回復 14# jackyq
明確的宣告變數型態 ,可使程式碼不易出錯,且容易偵錯

Option Explicit
Dim vD 'As Object
Sub Ex()
'如 Dim vD 需有執行 Ex1後再執行 Ex
'如是 Dim vD As Object 就不需先執行 Ex1
MsgBox vD Is Nothing 'Dim vD 程式執行錯誤了
Set vD = Nothing
MsgBox vD Is Nothing
If vD Is Nothing Then
Set vD = CreateObject("Scripting.Dictionary")
End If
End '結束所有的程序執行
End Sub
Sub Ex1()
MsgBox IsObject(vD)
If Not IsObject(vD) Then
Set vD = CreateObject("Scripting.Dictionary")
End If
MsgBox vD Is Nothing
'End
End Sub

複製代碼

作者: jackyq 時間: 2016-4-23 10:39

回復 15# GBKEE

http://forum.twbts.com/redirect. ... 0&fromuid=21301

我有改正押 cc....

作者: luhpro 時間: 2016-4-23 13:59

回復 14# jackyq
嗯...
因為我大都是看小幫手與本站自學,
有時忙沒看到的討論串就只能錯失學習了,

在小幫手裡的說明:
Dictionary 物件
  描述
物件，用於儲存資料關鍵字和項目對。
語法
Scripting.Dictionary
請注意
Dictionary 物件與 PERL 相關陣列全等。可以是任何型式的資料的項目被儲存在陣列中。每個項目都與一個唯一的關鍵字相關。該關鍵字用來取出單個項目，通常是整數或字串，可以是除陣列外的任何型態。
下面的程式碼舉例說明了如何建立一個 Dictionary 物件：
Dim d                '建立一個變數
Set d = CreateObject(Scripting.Dictionary)
d.Add "a", "Athens"    '加入一些關鍵字和項目
d.Add "b", "Belgrade"d.Add "c", "Cairo"
...

所以,我一直學到的都是 Dictionary 物件要用 Variant 資料型態來宣告,
早先為了解決類似的錯誤, Is Nothing, Is Null, = Null, .... 試了一堆方法耗時挫折,
後來乖乖的用錯誤處理程式處理才順利,
謝謝分享指正.

作者: chaoyiho 時間: 2016-4-25 19:19

回復 13# luhpro

抱歉前輩，到現在才回
那是因為我一直想要將您的講解try出來之後再回報我的問題與發現
可是我發現我搞了幾天還是沒能try出來...
真的是能力非常不足
所以今天加班務必希望可以研究出來!!

加上我因為權限的關係無法下載附檔
請問前輩可以將檔案寄到我的信箱嗎?
讓我有個參考..
我的信箱是:
[email protected]

研究您說的這些結果一個都沒有試出來一直出現錯誤
我想絕對是因為我的程式碼貼錯地方
因為是初學者的關係
所以資料特別混亂
今天卯起來把程式碼通通做一個整理
現在程式碼已經做好分類雖然還是很隴長...

我的問題主要有兩個
1.嘗試前輩上面的程式碼可能因為不知道該放哪邊而造成錯誤進而無法執行
2.關於重複動作的程式碼縮減

感謝前輩們的幫忙!!

作者: chaoyiho 時間: 2016-4-25 19:21

回復 15# GBKEE

感謝版主!!
那再請問版主請問您這個程式碼的意義試怎麼一個邏輯呢?
希望可以針對這樣的程式碼該放在哪裡做宣告與程式碼內容做個講解
我真的很希望可以學會
再次謝謝版主!!

作者: chaoyiho 時間: 2016-4-25 19:24

回復 12# c_c_lai

感謝cc大的回覆
我有嘗試照著您的指示修改
但是卻會發現出現一個新問題
activeX 錯誤
Google了一下
我卻看不懂這到底是屬於一個什麼樣的東西
嘗試到工具列中尋找這個附件但是我找不到
請問這是什麼問題所導致
我又該怎麼解決呢?

作者: c_c_lai 時間: 2016-4-25 19:32

回復 20# chaoyiho
你把檔案壓縮上傳，以便確認你的問題所在。
因為你提出的訊息與修正內容無關。

作者: luhpro 時間: 2016-4-25 22:52

本帖最後由 luhpro 於 2016-4-25 22:56 編輯

回復 luhpro
...
加上我因為權限的關係無法下載附檔
...
chaoyiho 發表於 2016-4-25 19:19

咦?
剛剛查了本網站的說明小學生有 "下載/查看附件" 的權限耶,
你不能嗎?

[attach]24003[/attach]

提供另一個下載點 :
http://www.FunP.Net/695648

我的問題主要有兩個
1.嘗試前輩上面的程式碼可能因為不知道該放哪邊而造成錯誤進而無法執行

如附網址的檔案,
試試看若有問題再提出.

2.關於重複動作的程式碼縮減

主要是把重複的程式碼獨立出來放在 Module 內,
以 Public Sub 被呼叫程序名() 做開頭(如此整個檔案都能呼叫此程序),
在確保每個呼叫點都不會因改成此呼叫而走樣的情形下,
以呼叫此程序的程式碼取代原重複的程式碼.

好處是易於維護與偵錯,
之後修改程式只需變動此程序內容,
中斷點也只要設在此程序內即可.
不用一個一個去尋找及修改程式碼或設中斷點.

作者: chaoyiho 時間: 2016-4-26 09:59

回復 22# luhpro

感謝前輩我已經下載來試用
試用之後發現其備可能誤會我的意思了
我用圖解
如下圖(一)這是執行前輩幫忙的程式後的結果
[attach]24008[/attach]
圖中跑出的是165字樣
但我想要的執行結果則是如圖(二):
[attach]24009[/attach]
像是這個樣子的核取方塊樹狀圖

圖(二)是我在分析後的表格中之標籤列下的篩選箭頭篩選VSL(船舶)出來的截圖
如圖(三)所示
[attach]24010[/attach]

不知道我解是這樣前輩可以好理解嗎?

我現在正在研究您的程式碼部分
如果前輩有做修改與回復再麻煩請您給個另外載點
因為我真的沒有權限
謝謝您不辭辛勞的教導!!

作者: c_c_lai 時間: 2016-4-26 11:20

回復 23# chaoyiho
[attach]24014[/attach]

作者: chaoyiho 時間: 2016-4-26 12:12

回復 24# c_c_lai

前輩好，感謝您的回覆
剛剛我嘗試照著您的回文作程式碼修改後
發現問題
在開啟舊檔之後，一按下執行分析就會出現錯誤代碼91
當然因為在有檢查錯誤程式碼之下
可以繼續跑完程式
但是最右邊卻不會出現如前輩的那樣處理完成畫面
請問這是什麼原因呢?

作者: chaoyiho 時間: 2016-4-26 13:54

回復 24# c_c_lai

前輩好，剛剛回文的問題我在經過測試之後發現原來是檔案開啟順序的錯誤
所以已經解決
現在正在嘗試將這個語法套用至全部的處理表單上(希望不會有錯誤)

但是還有一個最重要的問題就是
雖然現在已經有出現篩選船舶選項
但是它僅僅只是出現，點擊之後並不會對要分析表單中的VSL(船舶)做篩選動作

請問這個部分該怎麼處理呢?
點擊之後讓他可以對表格做篩選動作?

作者: c_c_lai 時間: 2016-4-26 16:32

回復 26# chaoyiho
點擊之後對要分析表單中的VSL(船舶)做篩選動作？
不甚了解，處理過程能否詳一一細舉例說明？

作者: chaoyiho 時間: 2016-4-26 17:04

回復 27# c_c_lai

用圖解比較清楚!
就是說像下面這張圖
[attach]24021[/attach]
這是分析過後的表格相信您知道的!
最上面的標籤列下方有個按鈕是篩選的功能相信您也能看到
點擊這個東西他會跑出下圖的核選方塊樹狀圖
[attach]24023[/attach]
他的功能就是可以只顯示我要看的船名對船舶做篩選而不是一次全部看
而在前輩幫助下建立的這個顯示畫面的確可以對船舶做複選
但是卻無法像那個核選方塊樹狀圖這樣可篩選自己想看的資料或全部都不選
不知道小弟這樣解釋
前輩您可以明白嗎?

作者: c_c_lai 時間: 2016-4-26 18:15

回復 28# chaoyiho
那為何不直接使用 "手動篩選"？又可重複使用。

作者: c_c_lai 時間: 2016-4-26 19:50

回復 28# chaoyiho
[attach]24024[/attach]

作者: c_c_lai 時間: 2016-4-26 19:55

回復 28# chaoyiho

Dim cts As Integer
With ActiveSheet.PivotTables("樞紐分析表1").PivotFields(" VSL")
For cts = 0 To EXCEL表單處理介面.ListBox1.ListCount - 1
.PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = IIf(EXCEL表單處理介面.ListBox1.Selected(cts), True, False)
Next cts
End With

複製代碼

作者: c_c_lai 時間: 2016-4-27 07:39

回復 28# chaoyiho
如果你想要在於點選『執行分析』後，所有增列之
Sav、J.C.W、P.C.O、Pmax、Stuffing Box、F.O.、
Exh、Exh 工作表單 VSL 均與「總表」對應之
VSL 同步，則將 "#樓上" 增列的新增「程式碼」
內容移至

Sheets("工作表1").Select
Sheets("工作表1").Copy Before:=Sheets(1)
Sheets("工作表1 (2)").Select
Sheets("工作表1 (2)").Copy Before:=Sheets(1)
Sheets("工作表1 (3)").Select
Sheets("工作表1 (3)").Copy Before:=Sheets(1)
Sheets("工作表1 (4)").Select
Sheets("工作表1 (4)").Copy Before:=Sheets(1)

複製代碼

之前一列。如此上列工作表單便能同步處理同步資料了。
反之，如果你僅僅想「總表」工作表單單獨對應
"EXCEL表單處理介面.ListBox" 的連結就 OK 了，
那就保持在 CommandButton3_Click() 結束前處理。

作者: c_c_lai 時間: 2016-4-27 07:46

回復 28# chaoyiho

' 2016/04/26 增加與 "EXCEL表單處理介面.ListBox" 的連結。
Dim cts As Integer
With ActiveSheet.PivotTables("樞紐分析表1").PivotFields(" VSL")
For cts = 0 To EXCEL表單處理介面.ListBox1.ListCount - 1
' .PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = IIf(EXCEL表單處理介面.ListBox1.Selected(cts), True, False)
' 更簡潔、扼要直接的 Assignment 的表示式。
.PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = EXCEL表單處理介面.ListBox1.Selected(cts)
Next cts
End With

複製代碼

接下看你自己如何去變化它了。

作者: c_c_lai 時間: 2016-4-27 08:00

[attach]24027[/attach]

[attach]24028[/attach]

作者: chaoyiho 時間: 2016-4-27 09:48

回復 34# c_c_lai

前輩您好感謝您這麼精細的回答真的讓我獲益良多
早上嘗試了您的做法於程式中
發現了兩個問題
1.如果像34#樓的那樣把兩個一樣的程式碼都貼在 CommandButton3_Click() 上就會出現Integer重複定義的問題
2.如果只貼其中一個則是會出現錯誤代碼91 沒有設定物件或定義區塊
現在還在努力查詢問題點在哪邊
但是現在看起來並不是開啟檔案順序或點選順序上的問題
不知道這是錯誤在哪邊呢?

作者: chaoyiho 時間: 2016-4-27 10:44

回復 34# c_c_lai

補上副檔
[attach]24032[/attach]

這是我貼上程式碼之後的樣子
[attach]24033[/attach]

會出現錯誤代碼91
並且右邊的船舶篩選欄不會顯示任何資訊

我現在正在想辦法
也再次麻煩前輩
幫我看看
分析檔案在之前的訊息裡面

作者: c_c_lai 時間: 2016-4-27 12:47

回復 36# chaoyiho
請先看懂 #32 的詳盡圖解說明，
從你程式的畫面與內容水準，
是應該會理解的。
你竟然是全吃下來？

作者: c_c_lai 時間: 2016-4-27 13:11

本帖最後由 c_c_lai 於 2016-4-27 13:17 編輯

回復 36# chaoyiho
[attach]24034[/attach]
這和我當初引導你的方式有所出入。
請回溯到 #12 的處裡。
即便你未加入 #34 的程式碼，
這個錯誤訊息業已存在。

作者: chaoyiho 時間: 2016-4-27 16:28

本帖最後由 chaoyiho 於 2016-4-27 16:29 編輯

回復 38# c_c_lai

前輩可能對我的處理方式誤會了
我有照著您的步驟下去做處理
如下方圖式:
1.[attach]24039[/attach]
2.[attach]24040[/attach]
3.[attach]24041[/attach]
4.[attach]24044[/attach]
5.[attach]24045[/attach]
6.[attach]24046[/attach]

但是實際執行之後就會出現
[attach]24047[/attach]

GOOGLE之後還是不知道ActiveX到底怎麼處理
有下載附件但是依然執行出現錯誤
所以我才使用LU大所建議的方式做處理
LU大的方式雖然可以跑出顯示但是就會有錯誤91的出現
並且無法做篩選

這一面牆我想我是當局者迷各位看官前輩應該也是醉了
有夠痛苦...
但是我一定要把他撞破!
再次麻煩前輩了!!!

作者: c_c_lai 時間: 2016-4-27 16:59

回復 39# chaoyiho
很單純地，從頭到尾你只需修改：
一、
[attach]24048[/attach]
二、
[attach]24049[/attach]
三、
[attach]24050[/attach]
四、
[attach]24051[/attach]
就全部更新了。如照這樣修正仍還有錯誤
將它上傳我會來檢查。

作者: jackyq 時間: 2016-4-27 17:16

回復 39# chaoyiho

那個訊息代表2意義
(1) 物件不存在註冊表中
(2) 你可能打錯名
答案=(2)
Set a = CreateObject("scripting.dictionary")

作者: c_c_lai 時間: 2016-4-27 19:41

回復 39# chaoyiho
#40 是我比較常用的處理方式 (從早期傳統系統到目前)，
因為 ListBox 是在 "EXCEL表單處理介面" 裡執行處理，
習慣上我會將字典的作業直接放置在 UserForm 裡宣告
與處裡，而並不將它置於 UserForm 外宣告，除非它在
UserForm 區塊外亦被其它程式模組使用、運用到除外。

如果你覺得如何宣告均無妨，只要系統能動便 OK 的話
(我是不贊成你以此種方式來學習編撰程式)；那我就以
你傳來的 "錯誤訊息" 來做解答吧 (檔案.rar)！
[attach]24052[/attach]
亦即在你目前之 Module1 上頭加上：

Private Sub Auto_Open()
Set vD = CreateObject("Scripting.Dictionary") ' 建立物件。
End Sub

複製代碼

作者: c_c_lai 時間: 2016-4-27 19:47

本帖最後由 c_c_lai 於 2016-4-27 19:50 編輯

回復 39# chaoyiho
對應 EXCEL表單處理介面.ListBox 的部分，
與 #40 是一致的。
[attach]24053[/attach]
擇一選擇加入 (請看備註說明)，
AB 不能全部通吃 (這便是你看到的
重複 Integer 的錯誤訊息)。

接下來全交給了。

作者: chaoyiho 時間: 2016-4-28 08:39

回復 43# c_c_lai

前輩早，抱歉現在才回文
因為昨天有點事情耽擱了...
您上面的回文我現在馬上來處理看看~~!!

但是關於回文前的那個步驟我的確是照著做了
卻是會出現 ActiveX 無法建立物件的錯誤
如附檔
[attach]24057[/attach]

真的不知道到底怎麼了 Q_Q

如果您看見了再麻煩您幫我檢查一下!!
謝謝您

痾...對了我沒有權限所以無法在這裡抓東西
希望前輩再麻煩一下給我個下載點或網址或直接寄送至我的信箱[email protected]
我會馬上回復
再次感謝

作者: chaoyiho 時間: 2016-4-28 08:41

回復 41# jackyq

前輩您好
您的意思是 activex的錯誤是因為這一句語法錯誤嗎?
但是我檢查完之後
應該沒有錯啊(?)
可以請您說明詳細一點嗎?

作者: jackyq 時間: 2016-4-28 09:09

本帖最後由 jackyq 於 2016-4-28 09:12 編輯

回復 44# chaoyiho

Set vD = CreateObject("scripting.dictionary")

你少了一個 i

另外 LongPtr
用 long 就可以了

作者: chaoyiho 時間: 2016-4-28 09:20

回復 46# jackyq

真的少了一個 i !!!

但是就算加上去我還是持續出現activex錯誤....
作者: jackyq 時間: 2016-4-28 09:24

本帖最後由 jackyq 於 2016-4-28 09:30 編輯

EXCEL表單處理介面裡面的

Private Sub UserForm_Initialize()

Dim hWndForm As LongPtr
Dim IStyle As LongPtr

Set vD = CreateObject("scripting.dictonary")

改成如下

Private Sub UserForm_Initialize()

Dim hWndForm As Long
Dim IStyle As Long

Set vD = CreateObject("scripting.dictionary")

存檔後 , 關閉再重開啟

改完後我這邊執行就ok 了啊
作者: jackyq 時間: 2016-4-28 09:34

另外
把 EXCEL表單處理介面裡面的第一行 Option Explicit  暫時先拿掉
作者: c_c_lai 時間: 2016-4-28 09:35

本帖最後由 c_c_lai 於 2016-4-28 09:48 編輯

回復 44# chaoyiho
第一個問題：變數宣告前後不一
Private Sub CommandButton1_Click()

If Application.FindFile = False Then

      MsgBox "您沒有開啟母檔"

End If

Dim lRow&       '  Dim lRrow&  (錯誤的變數宣告)

lRow = 3       '  lRrow = 3 (錯誤的變數宣告)

EXCEL表單處理介面.ListBox1.Clear '  避免重複貼製，造成與 "手動篩選" 項目不符

vD.RemoveAll

While Cells(lRow, 5) <> ""

   If Not vD.Exists(CStr(Cells(lRow, 5))) Then

      EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lRow, 5))

      vD(CStr(Cells(lRow, 5))) = lRow

   End If

   lRow = lRow + 1

Wend          '  上有 While 而無結束處裡 (Wend)

End Sub
複製代碼
第一個問題：產生 ActiveX 的原因
Private Sub UserForm_Initialize()

Dim hWndForm As Long       '  LongPtr 是 64 位元的長整數指標宣告

Dim IStyle As Long

'  Set vD = CreateObject("scripting.dictonary") '  少一個 i

Set vD = CreateObject("Scripting.Dictionary")

hWndForm = FindWindow("ThunderDFrame", Me.Caption)

IStyle = GetWindowLong(hWndForm, GWL_STYLE)

IStyle = IStyle Or WS_THICKFRAME '(還原)

IStyle = IStyle Or WS_MINIMIZEBOX '(最小化)

IStyle = IStyle Or WS_MAXIMIZEBOX '(最大化)

SetWindowLong hWndForm, GWL_STYLE, IStyle

End Sub
複製代碼
jackyq 大大指證出你  ActiveX 的錯誤點了，原因是你輸錯字了
Set vD = CreateObject("scripting.dictonary") ，少一個 i  ，
與大小寫無關，年紀大了畢竟視力退很多了，不仔細還真沒看到呢！
謝謝 jackyq 大大。
作者: jackyq 時間: 2016-4-28 09:37

再另外
把 EXCEL表單處理介面裡面的這段加入藍字部分

Private Sub CommandButton1_Click()
If Application.FindFile = False Then
      MsgBox "您沒有開啟母檔"
End If
Dim lRrow&
lRrow = 3
vD.RemoveAll
While Cells(lRow, 5) <> ""
   If Not vD.Exists(CStr(Cells(lRow, 5))) Then
      EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lRow, 5))
      vD(CStr(Cells(lRow, 5))) = lRow
   End If
   lRow = lRow + 1
End With
End Sub
作者: chaoyiho 時間: 2016-4-28 10:13

回復 50# c_c_lai

我真的...不知道要怎麼感謝兩位的大恩大德
乾脆請吃飯好了!!

但是重點....
我....
又錯誤了這次是全新的錯誤1004
出現在我輸紐分析的內部
之前分析都沒有問題怎麼現在前面問題解決之後會跑出這個呢?
如圖
[attach]24058[/attach]

上天真的給我好多的考驗阿....
作者: c_c_lai 時間: 2016-4-28 10:20

回復 52# chaoyiho
這是你並無任何選項，接著直接點選 "執行分析" 所產生的，
是麼？
作者: jackyq 時間: 2016-4-28 10:23

本帖最後由 jackyq 於 2016-4-28 10:26 編輯

回復 52# chaoyiho

#51 樓我看錯了  ( While  看成 With )
更正一下
大大真的是來考大家眼力的 ( 找不同的遊戲 ?? )

Private Sub CommandButton1_Click()
If Application.FindFile = False Then
      MsgBox "您沒有開啟母檔"
End If
Dim lrow& ' c_c_lai 大大找出
lrow = 3
vD.RemoveAll
While Cells(lrow, 5) <> ""
   If Not vD.Exists(CStr(Cells(lrow, 5))) Then
      EXCEL表單處理介面.ListBox1.AddItem CStr(Cells(lrow, 5))
      vD(CStr(Cells(lrow, 5))) = lrow
   End If
   lrow = lrow + 1
Wend
End Sub
作者: c_c_lai 時間: 2016-4-28 10:23

回復 52# chaoyiho
這是你並無任何選項，接著直接點選 "執行分析" 所產生的，
是麼？
我已 E-Mail 傳表單處理系統3.2等待修改.xlsm，以及原先的
檔案.rar 了，你執行看看。
作者: c_c_lai 時間: 2016-4-28 10:28

回復 52# chaoyiho
[attach]24059[/attach]
這隻是你應用 luhpro 大大的處理模式：
[attach]24060[/attach]
作者: chaoyiho 時間: 2016-4-28 11:14

回復 54# jackyq

我發現我常常會這樣
請問前輩關於這樣的問題有什麼習慣或動作可以預防或養成嗎?

而且您會發現
我的程式碼內容都塞在USERFORM中
很多重複的贅句>>似乎有方式可以合併成一個一起宣告(Public?)

請教這該怎麼處理呢?
作者: chaoyiho 時間: 2016-4-28 11:19

回復 55# c_c_lai

前輩您的檔案我已經測試過了的確可以用!
經過我一行一行的比對語法後
我發現我的錯字漏字還真的很多...

前輩的處理方式是這個邏輯
1.開啟舊檔
2.篩選船舶
3.按下分析
4.結果

但是關於2.與3.
不知道有沒有可以重複動作的方式呢?
因為這樣子的方式似乎是一次性的
分析過後就無法再做篩選必須要重新再一次才有辦法處理了(?)
或是我又做錯了呢?
請前輩賜教!
作者: c_c_lai 時間: 2016-4-28 14:02

回復  c_c_lai

前輩您的檔案我已經測試過了的確可以用!
經過我一行一行的比對語法後
我發現我的錯字 ...
chaoyiho 發表於 2016-4-28 11:19

其實這非你之問題，ActiveWorkbook.PivotCaches 在做過一次之後，
似乎無法再次處理，就算是把所有工作表單刪除只剩下 "FORM_REPORT"
一樣會出現

執行階段錯誤 '5'
程序呼叫或引數不正確

說真格的，我並不孰悉 Excel 的 PivotTable 處哩，你可能要請教
版上的各位大大了。
作者: c_c_lai 時間: 2016-4-29 17:05

本帖最後由 c_c_lai 於 2016-4-29 17:14 編輯

回復 58# chaoyiho
針對 #58
不知道有沒有可以重複動作的方式呢?
因為這樣子的方式似乎是一次性的
分析過後就無法再做篩選必須要重新再一次才有辦法處理了(?)
------------------------------------------------------------------------
為解決僅能執行一次的困擾問題，修正成能夠重複「可多次執行」，即
『執行分析』之「樞紐分析表」，修改內容如下 (僅列示出修改部分)：
一、
Private Sub CommandButton3_Click()

If TestBookOpen("FORM_REPORT.xlsx") = "" Then MsgBox "檔案未開啟": Exit Sub '跳出程序

刪除分析結果表             '  增加刪除分析工作表單，以便再次『執行分析』

Range("A1:M50192").Select

Range("A2").Activate

Sheets.Add

'  ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

      "FORM_REPORT!R2C1:R50192C13", Version:=xlPivotTableVersion14). _

      CreatePivotTable TableDestination:="工作表1!R3C1", TableName:="樞紐分析表1", _

      DefaultVersion:=xlPivotTableVersion14

'  2016/04/29  修正僅能執行一次的困擾問題

'  原本『執行分析』之「樞紐分析表」僅能執行一次，為解決此一困擾問題，故將 TableDestination

'  傳入值 "工作表1!R3C1" 予以修正為 ActiveSheet.Name & "!R3C1"，如此便可多次執行了。

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

      "FORM_REPORT!R2C1:R50192C13", Version:=xlPivotTableVersion14). _

      CreatePivotTable TableDestination:=ActiveSheet.Name & "!R3C1", TableName:="樞紐分析表1", _

      DefaultVersion:=xlPivotTableVersion14

'  Sheets("工作表1").Select       '  原為「工作表1」，但執行第二次時為「工作表10」, 則會產生錯誤訊息

Sheets(ActiveSheet.Name).Select    '  為配合「可多次執行」，將表單名稱改以動態隨機處理 (2016/04/29)

Cells(3, 1).Select
複製代碼
二、
'  2016/04/26  增加與 "EXCEL表單處理介面.ListBox" 的連結。

'  所有增列之 Sav、J.C.W、P.C.O、Pmax、Stuffing Box、F.O.、

'  Exh、Exh 工作表單 VSL 均與「總表」對應之 VSL 同步；

'  則將 "以下 With ~ End With" 新增的「程式碼」內容移至此處。

Dim cts As Integer

With ActiveSheet.PivotTables("樞紐分析表1").PivotFields(" VSL")

      For cts = 0 To EXCEL表單處理介面.ListBox1.ListCount - 1

         '  .PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = IIf(EXCEL表單處理介面.ListBox1.Selected(cts), True, False)

         '  更簡潔、扼要的 Assignment 的表示式。

         .PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = EXCEL表單處理介面.ListBox1.Selected(cts)

      Next cts

End With

'  為配合「可多次執行」，予以修正改以動態對應新產生表單名稱，以免產生錯誤  (2016/04/29)

'  Sheets("工作表1").Select

Sheets(ActiveSheet.Name).Select

'  Sheets("工作表1").Name = "Liner"

Sheets(ActiveSheet.Name).Name = "Liner"

'  Sheets("工作表1").Copy Before:=Sheets(1)

Sheets(ActiveSheet.Name).Copy Before:=Sheets(1)

'  Sheets("工作表1 (2)").Select

Sheets(ActiveSheet.Name).Select

'  Sheets("工作表1 (2)").Name = "Exh"

Sheets(ActiveSheet.Name).Name = "Exh"

'  Sheets("工作表1 (2)").Copy Before:=Sheets(1)

Sheets(ActiveSheet.Name).Copy Before:=Sheets(1)

'  Sheets("工作表1 (3)").Select

Sheets(ActiveSheet.Name).Select

'  Sheets("工作表1 (3)").Name = "F.O Inlet"

Sheets(ActiveSheet.Name).Name = "F.O Inlet"

'  Sheets("工作表1 (3)").Copy Before:=Sheets(1)

Sheets(ActiveSheet.Name).Copy Before:=Sheets(1)

'  Sheets("工作表1 (4)").Select

Sheets(ActiveSheet.Name).Select

'  Sheets("工作表1 (4)").Name = "Stuffing Box"

Sheets(ActiveSheet.Name).Name = "Stuffing Box"

'  Sheets("工作表1 (4)").Copy Before:=Sheets(1)

Sheets(ActiveSheet.Name).Copy Before:=Sheets(1)

'  Sheets("工作表1 (5)").Select

Sheets(ActiveSheet.Name).Select

'  Sheets("工作表1 (5)").Name = "Pmax"

Sheets(ActiveSheet.Name).Name = "Pmax"
複製代碼
作者: c_c_lai 時間: 2016-4-29 17:09

本帖最後由 c_c_lai 於 2016-4-29 17:21 編輯

回復 58# chaoyiho
三、原本是在結束前處裡「總表」對應表單處理介面.ListBox 的選項清單。
      修改為增列之 Sav、J.C.W、與「總表」同步對應 VSL，如 ( 二、說明)；
      故以下更改為 "備註"。
'  2016/04/26  增加與 "EXCEL表單處理介面.ListBox" 的連結。

'  所有增列之 Sav、J.C.W、P.C.O、Pmax、Stuffing Box、F.O.、

'  Exh、Exh 工作表單 VSL 不需與「總表」對應之 VSL 同步；

'  亦即僅僅「總表」對應表單處理介面.ListBox 的選項清單。

'  則將 "以下 With ~ End With" 新增的「程式碼」內容移至此處。

'  Dim cts As Integer

'  With ActiveSheet.PivotTables("樞紐分析表1").PivotFields(" VSL")

'    For cts = 0 To EXCEL表單處理介面.ListBox1.ListCount - 1

         '  .PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = IIf(EXCEL表單處理介面.ListBox1.Selected(cts), True, False)

         '  更簡潔、扼要的 Assignment 的表示式。

'       .PivotItems(EXCEL表單處理介面.ListBox1.List(cts)).Visible = EXCEL表單處理介面.ListBox1.Selected(cts)

'    Next cts

'  End With

'  -------------------------------------------------------------------------

End Sub
複製代碼
為考慮閱覽者的了解前因後果，以明瞭前後修改原因及內容，特將修正前事項特別
予以備註方式保留，以便與修正後內容作比對，提醒並增進 "修業功力"。
作者: c_c_lai 時間: 2016-4-29 17:31

在 UserForm 內宣告 "公用字典" 物件模式：
[attach]24096[/attach]
第二支是 luhpro 大大指導的案例；
在 Module1 宣告 "公用字典" 物件模式：
[attach]24097[/attach]
提供同功能異處理的兩個Excel檔案，
供作學習參考。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)