12
返回列表 上一主題 發帖

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

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-7-3 21:43 | 只看該作者

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

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

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

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

20130627 VBA 案件以表單輸入建立資料 v.05.zip (113.76 KB)

收藏 分享

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
2#
發表於 2013-7-14 20:05 | 只看該作者
各位大師，之前可能是小弟說的不清楚，才沒人回應，在此我再重說一次需求：
檔案1：http://www.FunP.Net/368256
此檔表單UserForm1已完成
檔案2：http://www.FunP.Net/623352
此檔表單UserForem2中的Listbox1-5也製作好了
需求是：將UserForm1的功能加到UserForm2裡面

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
4#
發表於 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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2013-7-16 08:16 | 只看該作者
回復 4# jeffrey628litw
  1. 3# 這兩行須置於模組的頂端
  2. 01.Private Const Sh = "Sheet1"    '資料庫                   '模組的私用常數
  3. 02.Dim d As Object                                          '模組的私用變數
複製代碼
請將UserForm2 內的程式碼清空,貼上3#的程式碼,試試看
可行後再加上原本的, 刪除緊急度,新增緊急度......的程式碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2013-7-16 11:27 | 只看該作者
回復 6# jeffrey628litw
附檔的表單控制項名稱 與你原本附檔不一樣(需修改)


Book2.zip (19.89 KB)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
8#
發表於 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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
1  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2025-1-28 

2011兔年全勤獎章
10#
發表於 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

TOP

        靜思自在 : 為人處世要小心細心，但不要「小心眼」。
12
返回列表 上一主題