標題: 請問如何用Textbox新增資料到Sheet? [打印本頁]

---

作者: jeffrey628litw    時間: 2013-7-3 21:43     標題: 請問如何用Textbox新增資料到Sheet?

請問如何用Textbox新增資料到Sheet?

敝人對於VBA不懂，只會剪貼修改一下，所以程式需要大師幫忙修改。

裡面UserForm1是之前網路人家做好的，UserForm2是我想要做的。
請幫我將Part1、Part2、Part3功能結合起來。

---

作者: jeffrey628litw    時間: 2013-7-14 20:05

各位大師，之前可能是小弟說的不清楚，才沒人回應，在此我再重說一次需求：
檔案1：http://www.FunP.Net/368256
此檔表單UserForm1已完成
檔案2：http://www.FunP.Net/623352
此檔表單UserForem2中的Listbox1-5也製作好了
需求是：將UserForm1的功能加到UserForm2裡面

---

作者: GBKEE    時間: 2013-7-15 17:13

回復 2# jeffrey628litw
試試看

1. Private Const Sh = "Sheet1"    '資料庫                   '模組的私用常數
   
2. Dim d As Object                                          '模組的私用變數
   
3. Private Sub UserForm_Initialize()
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets(Sh)
   
6.         K = 2
   
7.         Do While .Cells(K, "A") <> ""
   
8.             d(.Cells(K, "A").Value) = ""
   
9.             K = K + 1
   
10.         Loop
    
11.     End With
    
12.     ListBox_1.List = d.KEYS
    
13. End Sub
    
14. Private Sub ListBox_1_Change()  '需修改 緊急度 ListBox控制項名稱
    
15.      資料制定 1                 '呼叫程式 傳遞參數 : 1
    
16. End Sub
    
17. Private Sub ListBox_2_Change()  '需修改 製程 ListBox控制項名稱
    
18.      資料制定 2                 '呼叫程式 傳遞參數 : 2
    
19. End Sub
    
20. Private Sub ListBox_3_Change()  '需修改 部門 ListBox控制項名稱
    
21.      資料制定 3                 '呼叫程式 傳遞參數 : 3
    
22. End Sub
    
23. Private Sub ListBox_4_Change()  '需修改 持有者 ListBox控制項名稱
    
24.      資料制定 4                 '呼叫程式 傳遞參數 : 2
    
25. End Sub
    
26. Private Sub ListBox_5_Change()  '需修改 案件  ListBox控制項名稱
    
27.      資料制定 5                 '呼叫程式 傳遞參數 : 2
    
28. End Sub
    
29. Private Sub 資料制定(OB As Integer)
    
30.     Dim xValue As String, i As Integer, xCellValue As String
    
31.     '***案件基本資料的TextBox 請修改 TextBox1-TextBox9
    
32.     For i = 1 To 9
    
33.          Controls("TextBox" & i) = ""                                       '案件基本資料的TextBox控制項.清空
    
34.     Next
    
35.     Set d = CreateObject("Scripting.Dictionary")                            '重設物件
    
36.       For i = 1 To 5
    
37.        If i <= OB Then
    
38.             xValue = xValue & Controls("ListBox_" & i).Value                '結合ListBox的值
    
39.         Else
    
40.             Controls("ListBox_" & i).Clear                                   'ListBox清單清除
    
41.         End If
    
42.       Next
    
43.       With Sheets(Sh)
    
44.         K = 2
    
45.         Do While .Cells(K, "A") <> ""
    
46.             xCellValue = Application.Phonetic(.Cells(K, "A").Resize(1, OB)) '結合儲存格的值
    
47.             If OB = 5 And xValue = xCellValue Then
    
48.                 For i = 1 To 9
    
49.                     Controls("TextBox" & i) = .Cells(K, OB).Offset(, i)     '案件基本資料的TextBox控制項.輸入資料
    
50.                 Next
    
51.                 Exit Sub
    
52.             ElseIf OB < 5 And xValue = xCellValue Then
    
53.                 d(.Cells(K, OB + 1).Value) = ""
    
54.             End If
    
55.             K = K + 1
    
56.         Loop
    
57.         If OB < 5 Then Controls("ListBox_" & OB + 1).List = d.KEYS
    
58.     End With
    
59. End Sub

複製代碼

---

作者: jeffrey628litw    時間: 2013-7-15 20:36

先在此感恩版大的幫忙...^^...

版主大大您好：我對於VBA實在很笨拙，請問我將你的程式貼過來後，是這裡有問題嗎?

Private Sub UserForm_Initialize()


Set DY = CreateObject("Scripting.Dictionary")
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_Click()和Private Sub ListBox4_Click()的程式
     
           
  
  
  

End Sub


Private Const Sh = "Sheet1"    '資料庫                   '模組的私用常數




    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

檔案在此(方便的話請您將檔案改好上傳給我下載)：http://www.FunP.Net/823425

---

作者: GBKEE    時間: 2013-7-16 08:16

回復 4# jeffrey628litw

1. 3# 這兩行須置於模組的頂端
   
2. 01.Private Const Sh = "Sheet1"    '資料庫                   '模組的私用常數
   
3. 02.Dim d As Object                                          '模組的私用變數

複製代碼

請將UserForm2 內的程式碼清空,貼上3#的程式碼,試試看
可行後再加上原本的, 刪除緊急度,新增緊急度......的程式碼

---

作者: jeffrey628litw    時間: 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

---

作者: GBKEE    時間: 2013-7-16 11:27

回復 6# jeffrey628litw
附檔的表單控制項名稱 與你原本附檔不一樣(需修改)


[attach]15456[/attach]

---

作者: jeffrey628litw    時間: 2013-7-16 15:32

回復 7# GBKEE


    版大您好，又要麻煩您了，我已經改了部分了，問題1：不過改到表單的-->持有者"新增持有者"這個OK-->案件"新增案件"OK -->但是 "結束新增" 就出現以下不知哪裡錯誤?
問題2：如何讓持有者"新增持有者"的資料存到正確位置 Sheet1的D欄
                          案件"新增案件          的資料存到正確位置 Sheet1的E欄

檔案下載網址：http://www.FunP.Net/710388

  Private Sub UpdateBox()
    d1.RemoveAll                                     <-------------------------------------------------------------------------------------------------這一段程式反黃
    d2.RemoveAll
    rng = Sheets("Sheet1").[A1].CurrentRegion
    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.ListBox_4.List = d1.keys
End Sub

---

作者: GBKEE    時間: 2013-7-16 18:33

回復 8# jeffrey628litw

1. Private Const Sh = "Sheet1"                              '模組的私用常數
   
2. Dim d As Object                                          '模組的私用變數
   
3. Private Sub UserForm_Initialize()    '表單初使化時的事件
   
4.     Set d1 = CreateObject("Scripting.Dictionary")  '你沒有設置變數
   
5.     Set d2 = CreateObject("Scripting.Dictionary")
   
6.     ' 程式碼
   
7.     '
   
8.    
   
9. End Sub

複製代碼

---

作者: jeffrey628litw    時間: 2013-7-16 20:21

回復 9# GBKEE


    感謝版大一直幫忙解決問題，你的解答真是一針見血，我在改的途中又遇到問題：
在最後"案件基本資料" 按下 "修改" 會出現下面程式反黃，我不知道是甚麼問題，又要請教版主了。

檔案下載網址：http://www.FunP.Net/331482

Private Sub CommandButton4_Click()
    With UserForm2
        myday = Trim(.TextBox8.Value)
        If myday <> "" And IsDate(myday) = False Then
            MsgBox "您輸入的完工日期無法辨別喔～", vbCritical + vbOKOnly, "請重新輸入"
            .TextBox8.SetFocus
            Exit Sub
        End If
        .Frame1.Enabled = True
        .Frame2.Enabled = True
        .CommandButton2.Enabled = True
        .CommandButton11.Enabled = True
        myname = .ListBox_4.Text
        mycase = .ListBox_5.Text
        r = d2(myname & "-" & mycase)
        For i = 1 To 9
            Sheets("Sheet1").Cells(r, i + 1).Value = .Controls("TextBox" & i).Value              <--------------------------------------------------------------這段程式會反黃
            .Controls("TextBox" & i).ForeColor = -2147483640
            .Controls("TextBox" & i).BackColor = yc
            .Controls("TextBox" & i).Locked = True
        Next i
        Call UpdateBox
        .ListBox_4.Text = myname
        .ListBox_5.Text = mycase
        .CommandButton4.Enabled = False
    End With
    MsgBox "已經完成儲存囉～", vbOKOnly, "請注意"
End Sub

---

作者: GBKEE    時間: 2013-7-17 16:04

本帖最後由 GBKEE 於 2013-7-17 16:09 編輯

回復 10# jeffrey628litw
在物件模組中(表單也是物件模組)  With UserForm2 => With Me  或可以不用  With

1.   r = d2(myname & "-" & mycase)  'r=無 -> Cells(r, i + 1)所以錯誤        
   
2.         For i = 1 To 9
   
3.             Sheets("Sheet1").Cells(r, i + 1).Value = .Controls("TextBox" & i).Value

複製代碼

試試這附檔

[attach]15471[/attach]

---

作者: jeffrey628litw    時間: 2013-7-17 21:52

本帖最後由 GBKEE 於 2013-7-18 06:02 編輯

版大非常感謝您的幫助，您的檔案已經完全符合我的需求，我會好好研習您的程式，再次感謝您，建議您可以將此檔案發文分享給其他人下載。

---

作者: jeffrey628litw    時間: 2013-7-18 15:47

版主大大，我已經將檔案整理好了，我想我就替你發文分享給大家下載使用好了。

---

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