GBKEE

回復 1# bridetobe

1. Private Sub CommandButton1_Click()
   
2.     Dim a_date  ' As String
   
3.     a_date = InputBox("輸入日期(例2014/7/1):")
   
4.     With Sheet2
   
5.         Set A = .Range("A2", .[a2].End(xlDown)).Find(what:=a_date, LookIn:=xlValues) '搜尋文字
   
6.     End With
   
7.     If Not A Is Nothing Then
   
8.         MsgBox ("有")
   
9.     Else
   
10.         MsgBox ("沒有資料")
    
11.     End If
    
12. End Sub
    
13. Private Sub CommandButton2_Click()
    
14.     Dim a_date As Date
    
15.     a_date = InputBox("輸入日期(例2014/7/1):")
    
16.     With Sheet2
    
17.         Set A = .Range("A2", .[a2].End(xlDown)).Find(what:=a_date, LookIn:=xlFormulas) '搜尋公式
    
18.     End With
    
19.     If Not A Is Nothing Then
    
20.         MsgBox ("有")
    
21.     Else
    
22.         MsgBox ("沒有資料")
    
23.     End If
    
24. End Sub

複製代碼

GBKEE

回復 4# bridetobe
試試看

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  ' As String
   
4.     Dim fndrange, fstaddress, i
   
5.     a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
   
6.     If a_date = "" Then Exit Sub  '取消時
   
7.     With Sheet2
   
8.     Set srcrange = .Range("A2", .[a2].End(xlDown))
   
9.         Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues) '搜尋文字
   
10.         'After     選擇性的 Variant。  指定儲存格，尋找將從該儲存格之後開始。此儲存格對應於從使用者介面尋找時的使用中儲存格位置。
    
11.         '注意 After 必須是尋找範圍中的單個儲存格。請記住尋找是從該儲存格之後   開始的；必須等到該方法循環回到此儲存格時，才會搜尋其內容。
    
12.         '如果未指定此引數，搜尋將從範圍的左上角儲存格之後開始
    
13.     End With
    
14.     If Not fndrange Is Nothing Then
    
15.         'fstaddress = fndress = fndrange.Address  '這裡錯誤 讓他無止盡的貼下去
    
16.         fstaddress = fndrange.Address
    
17.         i = 3
    
18.         Do
    
19.         Cells(i, 1).Value = fndrange.Offset(, 1)
    
20.         Cells(i, 2).Value = fndrange.Offset(, 2)
    
21.         Cells(i, 3).Value = fndrange.Offset(, 3)
    
22.         Cells(i, 4).Value = fndrange.Offset(, 4)
    
23.         Cells(i, 5).Value = fndrange.Offset(, 5)
    
24.         Cells(i, 6).Value = fndrange.Offset(, 6)
    
25.         Cells(i, 7).Value = fndrange.Offset(, 7)
    
26.         Set fndrange = srcrange.FindNext(AFTER:=fndrange)
    
27.         i = i + 1
    
28.         Loop Until fndrange.Address = fstaddress
    
29.     Else
    
30.         MsgBox ("沒有資料")
    
31.     End If
    
32. End Sub

複製代碼

GBKEE

回復 6# bridetobe
Find 會根據上ㄧ次Find的參數來搜尋

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  As String
   
4.     Dim fndrange As Range, fstaddress As String, i As Integer
   
5.     a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
   
6.     If a_date = "" Then Exit Sub  '取消時
   
7.     With Sheet2
   
8.     Set srcrange = .Range("A2", .[a2].End(xlDown))
   
9.         srcrange.Interior.ColorIndex = xlNone
   
10.         Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues, lookat:=xlWhole) '搜尋文字
    
11.         'After     選擇性的 Variant。  指定儲存格，尋找將從該儲存格之後開始。此儲存格對應於從使用者介面尋找時的使用中儲存格位置。
    
12.         '注意 After 必須是尋找範圍中的單個儲存格。請記住尋找是從該儲存格之後   開始的；必須等到該方法循環回到此儲存格時，才會搜尋其內容。
    
13.         '如果未指定此引數，搜尋將從範圍的左上角儲存格之後開始
    
14.                
    
15.         'LookAt  選擇性的 Variant。可為下列 XlLookAt 常數之一：xlWhole 或 xlPart。
    
16.         
    
17.     End With
    
18.     If Not fndrange Is Nothing Then
    
19.         'fstaddress = fndress = fndrange.Address  '這裡錯誤 讓他無止盡的貼下去
    
20.         fstaddress = fndrange.Address
    
21.         i = 3
    
22.         Do
    
23.             fndrange.Interior.Color = vbRed
    
24.             Cells(i, 1).Resize(1, 7) = fndrange.Offset(, 1).Resize(1, 7).Value
    
25.             Set fndrange = srcrange.FindNext(AFTER:=fndrange)
    
26.             i = i + 1
    
27.         Loop Until fndrange.Address = fstaddress
    
28.     Else
    
29.         MsgBox ("沒有資料")
    
30.     End If
    
31. End Sub

複製代碼

GBKEE

回復 9# bridetobe

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  As String
   
4.     Dim fndrange As Range, fstaddress As String, i As Integer
   
5.     a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
   
6.     Application.ScreenUpdating = False
   
7.    '******************
   
8.     Range("A3", Range("A3").End(xlDown)).Resize(, 7).ClearContents
   
9.     '*****************
   
10.     If a_date = "" Then Exit Sub

複製代碼

1. Private Sub CommandButton2_Click()
   
2.    Dim Rng As Range
   
3.    With Sheets("操作")
   
4.        Set Rng = .Range("A3", .Range("A3").End(xlDown)).Resize(, 7)
   
5.        With Sheets("存貨資料").Range("B1").End(xlDown).Offset(1)
   
6.             .Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
   
7.             .Offset(, -1).Resize(Rng.Rows.Count) = Sheets("操作").[b1]
   
8.         End With
   
9.     End With
   
10. End Sub

複製代碼

GBKEE

結果讀出變成無法使用??
bridetobe 發表於 2014/8/7 11:28

1. Private Sub CommandButton2_Click()
   
2.    Range("A59").Select
   
3.     Selection.CurrentRegion.Select
   
4.     Selection.Copy
   
5.     Sheets("Sheet4").Select
   
6.     With Sheet4
   
7.         ActiveSheet.Paste
   
8.         'Range("A1:G2").Select   '這裡出錯
   
9.         '這CommandButton2是"操作"工作表[物件模組]的程序
   
10.         'Range("A1:G2").Select是"操作"工作表的Range.Select,不是ActiveSheet的Range.Select
    
11.         
    
12.         '如CommandButton2_Click()程式碼複製在一般模組
    
13.         '這Range是ActiveSheet的Range
    
14.     .Range("A1:G2").Select  '前面的. 表為With Sheet4的物件,屬性..
    
15.     Application.CutCopyMode = False
    
16.     Selection.ClearContents
    
17.     Range("A4").Select
    
18.     Selection.CurrentRegion.Select
    
19.     Selection.Copy        
    
20. End With
    
21. End Sub

複製代碼