依對話框要求寫入資料

myleoyes

各位前輩你們好!
         前輩!!問題如附檔說明
           請知道的前輩,不吝賜教謝謝再三!!

luhpro

Sub 資料() 'K2
  Dim iRows%, iNum%, iI%
  Dim vData, vTimes
  
  iRows = [A65535].End(xlUp).Row
  iNum = 3
  
  vData = Application.InputBox("輸入數字", "請輸入資料", Range("AA1"), Type:=2)
  Do Until vData = 0 Or vData = "" Or iNum > iRows
    Range("AA1") = vData
    vTimes = Application.InputBox("輸入次數", "請輸入寫入資料的次數", Type:=2)
    If vTimes = 0 Or vTimes = "" Then
      Exit Sub
    Else
      For iI = 0 To vTimes - 1
        Cells(iNum + iI, 2) = vData
      Next
      iNum = iNum + iI
    End If
    If iNum <= iRows Then
      vData = Application.InputBox("輸入數字", "請輸入資料", Range("AA1"), Type:=2)
    End If
  Loop
End Sub

cw3076

試試看是不是你要的~


    Leov52R1.rar (14.83 KB)

下載次數: 11

2011-5-25 23:49

GBKEE

回復 1# myleoyes
是這樣嗎
   

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.       If Target(1).Address = "$L$2" Then Ex
   
3. End Sub
   
4. Private Sub Ex()
   
5.     Dim Rng(1 To 2) As Range, A
   
6.     Set Rng(1) = Cells(Rows.Count, "A").End(xlUp)
   
7.     Set Rng(2) = Cells(Rows.Count, "L")
   
8.     Do While Rng(1).Row <> Rng(2).End(xlUp).Row
   
9.         A = Application.InputBox("輪入第" & Rng(2).End(xlUp).Row - 1 & "個數字", Type:=1)
   
10.         If A = False Then Exit Do
    
11.         Rng(2).End(xlUp).Offset(1) = A
    
12.     Loop
    
13. 
    
14. End Sub

複製代碼

myleoyes

回復 4# GBKEE
GBKEE前輩你好!
cw3076前輩你好!
     　 良師!與cw3076 前輩謝謝!!兩位程式有誤謝謝再三!!
luhpro前輩你好!
        前輩!你的程式是對的但是資料卻
        寫入在B欄而非L欄呢?小弟實在無能力
        修改請再辛苦囉!謝謝再三!!

Hsieh

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim ar()
   
3. If Target.Address <> "$L$2" Then Exit Sub
   
4. x = InputBox("輸入數字", , [AA1])
   
5. y = InputBox("輸入次數", , 3)
   
6. Do Until x = "" Or y = ""
   
7. For i = 1 To y
   
8.   ReDim Preserve ar(s)
   
9.   ar(s) = x
   
10.   s = s + 1
    
11. Next
    
12. x = InputBox("輸入數字", , 123)
    
13. y = InputBox("輸入次數", , 3)
    
14. Loop
    
15. Range([L3], Cells(Rows.Count, 12).End(xlUp)) = ""
    
16. If s > 0 Then [L3].Resize(s, 1) = Application.Transpose(ar)
    
17. End Sub

複製代碼

myleoyes

回復 6# Hsieh
hsieh前輩你好!
       偶像前輩!謝謝!!程式雖好用
       但卻無法得知資料已經寫到第幾列
       所以無法停止輸入傷腦筋
       問題如附檔說明
       請再麻煩修改辛苦囉!謝謝再三!!

Hsieh

回復 7# myleoyes

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim ar()
   
3. If Target.Address <> "$L$2" Then Exit Sub
   
4. x = InputBox("輸入數字", , [AA1])
   
5. y = InputBox("輸入次數", , 3)
   
6. Do Until x = "" Or y = ""
   
7. For i = 1 To y
   
8.   ReDim Preserve ar(s)
   
9.   ar(s) = x
   
10.   If s = Application.Max([A:A]) Then GoTo 10
    
11.   s = s + 1
    
12. Next
    
13. x = InputBox("輸入數字", , 123)
    
14. y = InputBox("輸入次數", , 3)
    
15. Loop
    
16. 10
    
17. Range([L3], Cells(Rows.Count, 1).End(xlUp).Offset(, 11)) = ""
    
18. If s > 0 Then [L3].Resize(s, 1) = Application.Transpose(ar)
    
19. End Sub

複製代碼

myleoyes

回復 8# Hsieh
hsieh前輩你好!
       偶像前輩!謝謝!!真是太棒囉!
       辛苦囉!謝謝再三!!
       順便提到luhpro前輩的程式
       原來Cells(iNum + iI, 2) = vData是資料寫入在B欄
       改成Cells(iNum + iI, 12) = vData是資料寫入在L欄
       早上趕上班沒有打開隱藏欄所以發現無效
       不過程式還是少了的超出A列資料無法刪除

luhpro

回復 9# myleoyes
嗯...是的.
因為我習慣把程式結果產生在範例結果的旁邊以便比較是否有錯誤出現,
到發表的時候卻忘了把它改過來了,
這是我的疏忽造成你的不便敬請見諒.

"不過程式還是少了的超出A列資料無法刪除" 這句我看的不是很懂,
你範例檔中說到 "直記錄到A欄的最後一數據為止",
那不就應該是就以 A 欄的資料數量為產生數值的依據嗎?

如果是希望產生最後一筆資料後底下都一律清空的話,
可以在 Loop 底下增加一行 :
  Range(Cells(iRows + 1, 12), Cells(65536, 12)) = ""
即可.
(上面的那行也可順便變一下 : iRows = [A65536].End(xlUp).Row)