Board logo

標題: 請問如何用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/)