Board logo

標題: [發問] 輸入編號跑出資料 [打印本頁]
作者: gn00487767    時間: 2014-2-12 16:06     標題: 輸入編號跑出資料

本帖最後由 gn00487767 於 2014-2-12 16:12 編輯

煩請大大教學
[attach]17480[/attach]
[attach]17481[/attach]
該如何添加指令
作者: GBKEE    時間: 2014-2-12 17:04

回復 1# gn00487767
試試看
  1. Option Explicit
  2. Option Base 1
  3. Private Sub CommandButton1_Click()
  4.     Ex
  5. End Sub
  6. Private Sub TextBox1_Change()
  7.     Ex
  8. End Sub
  9. Private Sub Ex()
  10.     Dim Rng As Range, Ar, i As Integer
  11.     Ar = Array([C3], [G3], [C5], [G5], [C7], [C9])
  12.     Set Rng = Sheets("資料表").Range("A:A").Find(WHAT:=TextBox1, LOOKAT:=xlWhole)
  13.     For i = 1 To UBound(Ar)
  14.         If Not Rng Is Nothing Then
  15.             Ar(i).Value = Rng.Offset(, i)
  16.         Else
  17.             Ar(i).Value = ""
  18.         End If
  19.     Next
  20. End Sub
複製代碼
作者: stillfish00    時間: 2014-2-12 17:19

回復 1# gn00487767
TextBox1有使用需求嗎? 拿掉會清爽一點。
資料龐大可以參考下面，只用match找一次。
  1. Private Sub CommandButton1_Click()
  2.   Dim lRow As Long, sID As String
  3.   
  4.   sID = Sheets("表格").[E1].Value
  5.   If sID <> "" Then
  6.     With Sheets("資料表")
  7.       On Error Resume Next  '忽略找不到時的 Error
  8.       lRow = Application.Match(sID, .Range(.[A1], .[A1].End(xlDown)), 0)
  9.       On Error GoTo 0 '還原
  10.     End With
  11.    
  12.     If lRow > 0 Then
  13.       ar = Application.Transpose(Application.Transpose(Sheets("資料表").Cells(lRow, "B").Resize(, 6).Value))
  14.       With Sheets("表格")
  15.         .[C3].Value = ar(1)
  16.         .[G3].Value = ar(2)
  17.         .[C5].Value = ar(3)
  18.         .[G5].Value = ar(4)
  19.         .[C7].Value = ar(5)
  20.         .[C9].Value = ar(6)
  21.       End With
  22.     End If
  23.   End If
  24. End Sub
複製代碼
作者: gn00487767    時間: 2014-2-13 10:37

回復 2# GBKEE

感謝超級版主的教學
你的方法符合小弟的需求
只是小弟不太能理解,因為分的好散
多出那些EX是什麼意思
因為小弟是完全不懂慢慢研究的
作者: GBKEE    時間: 2014-2-13 10:48

回復 4# gn00487767
  1. Private Sub CommandButton1_Click()
  2.             Ex  '執行這程式 = Call Ex   
  3.             End Sub
複製代碼
作者: gn00487767    時間: 2014-2-13 10:50

回復 3# stillfish00

感謝stillfish00大大的指導
TextBox1是可以拿掉,
因為小弟之前剛學習時,很多連結都弄在TextBox1,所以才加上去的
再請問
ar = Application.Transpose(Application.Transpose(Sheets("資料表").Cells(lRow, "B").Resize(, 6).Value))
裡面的"B"是代表B欄嗎
裡面的 6 是代表 B欄之後的6欄嗎?
因為小弟真的是由完全不懂自行亂湊出來的
作者: gn00487767    時間: 2014-2-13 11:03

回復 5# GBKEE

再請問大大,那這2個呢
01.Option Explicit
02.Option Base 1
小弟試過拿掉他們
但執行後位置都亂了
作者: GBKEE    時間: 2014-2-13 11:33

回復 7# gn00487767
vba視窗,有一說明指令,輸入 Option Explicit 有說明
作者: stillfish00    時間: 2014-2-14 12:50

回復 6# gn00487767
裡面的"B"是代表B欄嗎
裡面的 6 是代表 B欄之後的6欄嗎?

是的
作者: gn00487767    時間: 2014-2-16 02:34

回復 3# stillfish00

再次請教 stillfish00 大大
若整欄資料的話小弟又該怎麼做呢?
如附件
作者: sunnyso    時間: 2014-2-16 11:53

回復 1# gn00487767

一定要用vba嗎？單看圖, 用函數應該也可
作者: gn00487767    時間: 2014-2-16 22:15

回復 11# sunnyso


是的 sunnyso 大大
因為小弟就是都用函數 導致 檔案變的超大
所以才想說 能夠改成VBA的地方盡量改
不然開啟檔案很難開啟
作者: GBKEE    時間: 2014-2-17 06:46

回復 12# gn00487767
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Integer, Ar(), m As Variant
  4.     With Sheets("自動顯示")
  5.         ReDim Ar(2 To .Range("A1").End(xlDown).Row, 1 To 3) '指定二維陣列元素的下限索引值,上限索引值
  6.         For i = 2 To .Range("A1").End(xlDown).Row
  7.             m = Application.Match(.Range("A" & i), Sheets("資料表").Range("A:A"), 0)
  8.             '應用工作表函數搜尋編號
  9.             If IsNumeric(m) Then
  10.                 With Sheets("資料表").Range("A" & m)
  11.                     Ar(i, 1) = .Range("B1")     '名稱欄
  12.                     Ar(i, 2) = .Range("C1")     '日期欄
  13.                     Ar(i, 3) = .Range("D1")     '姓名欄
  14.                 End With
  15.             End If
  16.         Next
  17.         .[B2].Resize(UBound(Ar) - 1, UBound(Ar, 2)) = Ar
  18.     End With
  19. End Sub
複製代碼
作者: gn00487767    時間: 2014-2-17 15:24

回復 13# GBKEE

感謝大大不厭其煩的位小弟解答
但此代碼  日期的地方顯示一樣是顛倒的@@
小弟發現了另一個方式了
就是把我原有的函數全部套用 您再另一個主題給小弟的代碼
    With Sheets("XX").[X?:X?]
        .Cells = "   原有函數(只是原有的"X"要變成" "X" ")   "   
        .Cells = .Value '公式轉成值
    End With
這樣的方式就不用變動原本的函數而達到小弟的需求了^^
在此致上萬分的謝意^^
作者: GBKEE    時間: 2014-2-17 16:24

回復 14# gn00487767


   
日期的地方顯示一樣是顛倒的@@
請在工作表上手動改回原是其格式,再執行程式看看



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