返回列表 上一主題 發帖

[發問] 依據InputBox填入的日期顯示資料

[發問] 依據InputBox填入的日期顯示資料

測試檔︰ 依據InputBox填入的日期顯示資料.rar (23.32 KB)

請問︰以下程式的需求語法(2003版)應該如何編寫?
謝謝!

需求︰
1_先設立1個可輸入日期(yyyymmdd)的InputBox

2_在InputBox輸入X日期後,即可將該日期填入"七政","八卦","五行","六沖","合數","生肖","均值","尾數"的各工作表(以下簡稱"Arr”)的A1,
並將DATA的A欄=X日期的下1列之B︰H數值填入Arr ,如果該B︰H="”時,則Arr的A1也="”。

3_將完成第2項的"Arr"輸出為1個獨立檔案,檔案名稱="大樂透_遺漏空總統計表_輸入InputBox的日期”。
請詳見InputBox的日期=202010和20200717和20200721的三個效果檔範例。

本帖最後由 n7822123 於 2020-7-26 22:58 編輯

回復 1# papaya


DATA的A欄 是"字串格式" (2020/7/7  (二)),InputBox輸入的日期也是"字串格式" (2020707)

兩個格式都是"字串" 又長的不太一樣,要怎麼比?

用拆解字串方式?  會很麻煩阿!

建議日期就回歸到日期格式,可以用自訂格式 "yyyy/mm/dd (aaa)"

日期格式可以做運算,字串格式不能
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 2# n7822123
不好意思,因為剛接觸VBA,還不很清楚編寫的規矩,尚請見諒
因為DATA的資料是下載自APP軟體,所以請將DATA日期格式改為如2020/1/1,2020/7/17,2020/10/7即可,
InputBox輸入的日期格式,就配合更改後的DATA日期格式。
謝謝您

TOP

本帖最後由 n7822123 於 2020-7-27 00:58 編輯

回復 3# papaya


先幫你把A欄的格式改成日期格式,我自認註解寫不少....且防呆寫不少

所以程式寫的比較長一點,希望看的懂吧~ 程式如下


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr, 此表 As Worksheet, 日期 As Date, tim!, rg As Range, Rn&, xlsNm$, sh
Arr = Array("七政", "八卦", "五行", "六沖", "生肖", "合數", "均值", "尾數")
Set 此表 = ActiveSheet
'1_先設立1個可輸入日期(yyyymmdd)的InputBox
日期 = InputBox("請輸入日期,格式Ex:2020/07/07", "輸入日期")
If IsEmpty(日期) Then Exit Sub
'檔案名稱="大樂透_遺漏空總統計表_輸入InputBox的日期”
xlsNm = "大樂透_遺漏空總統計表_" & Format(日期, "mmdd")
'檢查是否已有檔案(避免重覆執行)
檢查$ = Dir(ThisWorkbook.Path & "\" & xlsNm & ".xls*")
If 檢查 <> "" Then
  re% = MsgBox("此檔案已存在,請確認是否覆蓋?", vbYesNo)
  If re = vbNo Then Exit Sub Else Kill ThisWorkbook.Path & "\" & 檢查
End If
tim = Timer  '開始計時
'比對日期
For Each rg In Range([A1], [A1].End(4))
  If rg = 日期 Then Rn = rg.Row: Exit For
Next
'如果該B︰H="”時,則Arr的A1也="”
If Rn = 0 Then MsgBox "找不到日期": Exit Sub
For Each sh In Arr
  With Sheets(sh): 此表.Activate
    '2_該日期填入"七政","八卦","五行","六沖","合數","生肖","均值","尾數"的各工作表
    .[A1] = Format(日期, "yyyy/mm/dd")
    '並將DATA的A欄=X日期的下1列之B︰H數值填入
    .[A3].Resize(7) = Application.Transpose(Cells(Rn + 1, 2).Resize(, 7))
  End With
Next
'3_將完成第2項的"Arr"輸出為1個獨立檔案
With Workbooks.Add
  For i = 0 To UBound(Arr)
    ThisWorkbook.Sheets(Arr(i)).Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets(Array(1, 2, 3)).Delete
  .SaveAs ThisWorkbook.Path & "\" & xlsNm    '沒給副檔名,舊板新版Excel都適用
  .Close True
End With
[Q2] = Round(Timer - tim, 2)
End Sub


檔案如下

49大樂透(主檔).rar (22.26 KB)

你另一帖需求感覺更多,光看起來就感覺有點麻煩.....

看有沒有人願意幫你,今天先這樣
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 papaya 於 2020-7-27 02:45 編輯

回復 4# n7822123
不好意思,夜深了。還勞駕您費神解題~不勝感激
測試成功
明天再仔細拜讀貴程式語法~希望自己有能力消化~再次致謝
=====================================
另一題~將全部的需求一次提出~原本是希望能讓解題的語法有其連貫性和一 致性,
沒想到反而顯得需求複雜而令人卻步~哈~哈~

TOP

本帖最後由 papaya 於 2020-7-27 05:30 編輯

回復 4# n7822123
不好意思,請問:
列38    .Sheets(Array(1, 2, 3)).Delete
Array(1, 2, 3)是指什麼範圍的工作表被刪除了?
謝謝您^^

TOP

回復 6# papaya


Array(1, 2, 3)是指什麼範圍的工作表被刪除了?

新增活頁簿會預設有3個工作表,所以把前3個工作表刪除

你把那一行註解掉,再執行就知道是什麼了  

如果不一次寫,要分三行寫,會變成如下(連續刪除第一頁工作表,3次)


sheets(1).delete
sheets(1).delete
sheets(1).delete
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 7# n7822123
謝謝您的耐心說明^^

TOP

本帖最後由 papaya 於 2020-7-28 01:32 編輯

回復 4# n7822123
承4#的解答(萬分感謝您詳細的文字註解)

續增需求︰
以主檔的Arr各工作表名稱(以下簡稱S)及S的B欄和C欄,搜尋.CSV轉換為.XLS後的檔案(以下簡稱D檔)名稱中之第3,4,5小段有相同"關鍵字"的檔案,
並複製D檔AZ欄=S的A1(或=InputBox輸入的日期)的日期之上1列的BA︰BS內容,貼上S之相對應E欄儲存格。
Ex1︰以InputBox=" 2020/5/15”為例~
將遺漏大數據-大樂透-七政排序-空數總覽--第二第三第四第五最末-(2020-07-21)的AZ21(2020/5/15)之上1列的BA20︰BS20內容,
貼上S=七政,B欄=,C欄=第二第三第四第五最末,E欄=E7(=1,6,12,16,17,18,26,28,36,37,38,46,48,49)。

Ex2︰以InputBox="2020/7/21”為例~
將遺漏大數據-大樂透-生肖排序-空數總覽--第二第三最末-(2020-07-21)的AZ2 (2020/7/21)之上1列的BA1︰BS1內容,
貼上S=生肖,B欄=,C欄=第二第三最末,E欄=E20(=14,16,17,18,22,25,27,31,32,33,35,48,49)。

其餘…….以此類推。

測試檔︰ TSET.rar (171.88 KB)

以上   請您繼續賜教~謝謝您^^

備註︰
1_我對VBA還是處於敲門(尚稱不上入門)階段,所以對流程順序或相關的操作方式,還不清楚,
因此相關的流程順序和比對的母子體或方式都勞駕以您的構想為宜。謝謝您!


2_為因應每執行一次的CSV(由APP產生)的A欄日期格式,所以我自行將主檔操作的日期格式改為”yyyy/m/d”。

TOP

本帖最後由 papaya 於 2020-7-28 06:48 編輯

忘了說明一點︰
因為只有第1次在InputBox輸入日期時,有需要用到.CSV檔案來產生.XLS檔案
其餘後續再輸入的日期,就直接比對由第1次所產生的.XLS檔案即可,
所以您只要取測試檔中的子資料夾(轉換後的XLS)內的4個XLS檔案來測試就可以了
謝謝您

TOP

        靜思自在 : 愛不是要求對方,而是要由自身的付出。
返回列表 上一主題