返回列表 上一主題 發帖

[發問] 查詢日期帶出此日期的每筆資料

chyong911

帖子
6 
主題
3 
精華
0 
積分
14 
點名
0  
作業系統
WIN10 
軟體版本
Office 2010 
閱讀權限
10 
性別
女 
註冊時間
2018-5-23 
最後登錄
2019-4-30 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-4-25 15:31 | 顯示全部帖子

[發問] 查詢日期帶出此日期的每筆資料

本帖最後由 chyong911 於 2019-4-25 15:33 編輯

各位前輩好，因為自學VBA，概念沒有很純熟，做到一半卡關了，跪求協助QQ
想要寫一篇可以用"支票到期日"來從資料庫挖出此到期日的每筆支票號(不要重複)及此支票號的傳票單號、兌現日、公司別，但目前我寫的VBA目前只能寫出一筆Orz


我思考出的邏輯示意圖如下(但目前寫不出來)


寫的VBA為：
PS這一段每次按鈕下去都跑超久，是不是我寫得太不精簡了QQ有更好的方式嗎?
支票查詢.rar (129.42 KB)

Private Sub 查詢_Click()
'關閉螢幕跳躍
    Application.ScreenUpdating = False
    Sheets("票據簽收單").Select
   
    '匯出欄位使用
    Dim NumberColumn, DayColumn, SummonsColumn, BusinessColumn As Integer '支票號 '到期日'傳票單號'公司別
    X = Sheets("票據簽收單").Cells(9, "W") '輸入到期日
   
    '預設欄位位子
    NumberColumn = 6
    DayColumn = 6
    BusinessColumn = 6
    SummonsColumn = 6
   
   
    '清空查詢結果
    ClearFunction
   
    '執行查詢
For i = 3 To 1000 'data上限1000筆

        'InStr會傳回 Variant (Long)，指定另一個字串內某個字串的第一個出現位置。
        'InStr([ start ], string1, string2, [ compare ])
        'If Sheets("系統設定").Cells(i, "D").Contains(x) Then
        
    If InStr(Sheets("應付票據data").Cells(i, "C"), X) > 0 Then '找到第一格資料
           'Value
           r = Sheets("應付票據data").Cells(i, "AC").Row
           v = Sheets("應付票據data").Cells(i, "AC").Value
           For p = 0 To v - 1
            Sheets("票據簽收單").Cells(SummonsColumn, "X") = Sheets("應付票據data").Cells(i, "C") '傳票單號
            Sheets("票據簽收單").Cells(NumberColumn, "Y") = Sheets("應付票據data").Cells(i, "V") '支票號
            Sheets("票據簽收單").Cells(DayColumn, "z") = Sheets("應付票據data").Cells(i, "Y") '到期日
            Sheets("票據簽收單").Cells(BusinessColumn, "aa") = Sheets("應付票據data").Cells(i, "D") '公司別
            Next
            p = p + 1
     End If
Next
   
    NumberColumn = NumberColumn + 1
    DayColumn = DayColumn + 1
    SummonsColumn = SummonsColumn + 1
    BusinessColumn = BusinessColumn + 1
   
    Sheets("票據簽收單").Select
End Sub
------------------------------------------------------------------------------------
Private Sub 清除查詢_Click()
'關閉螢幕跳躍
    Application.ScreenUpdating = False
    Sheets("票據簽收單").Range("X6:AA17").ClearContents
    Sheets("票據簽收單").Cells(6, "W").ClearContents
    Sheets("票據簽收單").Cells(9, "W").ClearContents
   
End Sub
--------------------------------------------------------------------------------------
Private Sub ClearFunction()
    '關閉螢幕跳躍
    Application.ScreenUpdating = False
    Sheets("票據簽收單").Range(Cells(6, 24), Cells(12, 29)).ClearContents

End Sub



以上麻煩版上的各位前輩指教了Orz
收藏 分享

        靜思自在 : 看別人不順眼，是自己修養不夠。
返回列表 上一主題