- 帖子
- 228
- 主題
- 62
- 精華
- 0
- 積分
- 364
- 點名
- 20
- 作業系統
- Win 10
- 軟體版本
- Office 2007 & 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-3-5
- 最後登錄
- 2024-9-16
|
6#
發表於 2013-7-16 10:27
| 只看該作者
回復 5# GBKEE
版大您好，我試了把2個檔案和您的程式都貼進去，還是不行(我實在是看不懂不會改)，能否再請您幫忙看要修改的地方：
主要不知是不是這裏有問題?檔案下載網址：http://www.FunP.Net/678558
Private Sub UserForm_Initialize()
Set DY = CreateObject("Scripting.Dictionary") '這以下為Private Sub ListBox5_Change()和Private Sub ListBox4_Change()的程式
Set DZ = CreateObject("Scripting.Dictionary")
Set Sht1 = Sheets("Sheet1")
K = Sht1.[A65536].End(xlUp).Row
With Sht1
For Y = 2 To K
Ts = .Range("A" & Y): If DY(Ts) <> "" Then Else DY(Ts) = Ts: ListBox5.AddItem Ts
If .Range("D" & Y) <> "" Then TS1 = .Range("D" & Y)
If DZ(TS1) <> "" Then Else DZ(TS1) = TS1: ListBox1.AddItem TS1
Next
End With
Set DY = Nothing: Set DZ = Nothing: Y = 0: Ts = "": TS1 = "" '這以上為Private Sub ListBox5_Change()和Private Sub ListBox4_Change()的程式
yc = ListBox1.BackColor '這以下為Listbox1、Listbox2的程式
wc = TextBox1.BackColor
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheets("資料庫")
.Unprotect Password:="69123"
rng = .[A1].CurrentRegion
End With
For r = 2 To UBound(rng)
mycase = "-" & rng(r, 2)
If Trim(rng(r, 1)) <> "" Then
myname = Trim(rng(r, 1))
br = r
d1(myname) = r & "-" & r
Else
d1(myname) = br & "-" & r
End If
d2(myname & mycase) = r
Next r
UserForm2.ListBox1.List = d1.KEYS
UserForm2.CommandButton11.SetFocus '這以上為Listbox1、Listbox2的程式
Set d = CreateObject("Scripting.Dictionary")
With Sheets(Sh)
K = 2
Do While .Cells(K, "A") <> ""
d(.Cells(K, "A").Value) = ""
K = K + 1
Loop
End With
ListBox_1.List = d.KEYS
End Sub |
|
發表於 2013-7-17 16:04
| 
