麻辣家族討論版版 - Powered by Discuz! Board

標題: 依對話框要求寫入資料 [打印本頁]

作者: myleoyes 時間: 2011-5-25 21:11 標題: 依對話框要求寫入資料

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

作者: luhpro 時間: 2011-5-25 23:22

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 時間: 2011-5-25 23:49

試試看是不是你要的~

[attach]6340[/attach]

作者: GBKEE 時間: 2011-5-26 09:00

回復 1# myleoyes
是這樣嗎

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

複製代碼

作者: myleoyes 時間: 2011-5-26 13:10

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

作者: Hsieh 時間: 2011-5-26 14:06

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

複製代碼

作者: myleoyes 時間: 2011-5-26 21:53

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

作者: Hsieh 時間: 2011-5-26 22:14

回復 7# myleoyes

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

複製代碼

作者: myleoyes 時間: 2011-5-26 22:41

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

作者: luhpro 時間: 2011-5-26 22:57

本帖最後由 luhpro 於 2011-5-26 23:08 編輯

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

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

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

作者: GBKEE 時間: 2011-5-27 07:30

回復 10# luhpro
"Range(Cells(iRows + 1, 12), Cells(65536, 12)) = """
65536這數值是2003版的最大列數
只是建議用 Rows.Count 取代65536 可適用於任一版本

作者: myleoyes 時間: 2011-5-27 20:42

回復 10# luhpro
luhpro前輩你好!
      前輩!非常感激謝謝!就是增加這一行
      Range(Cells(iRows + 1, 12), Cells(65536, 12)) = ""
      才正確謝謝再三!!

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