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

papaya

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

下載次數: 5

2020-7-26 06:48

請問︰以下程式的需求語法(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

回復 1# papaya


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

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

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

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

日期格式可以做運算，字串格式不能

papaya

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

n7822123

回復 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)

下載次數: 4

2020-7-27 00:58

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

看有沒有人願意幫你，今天先這樣

papaya

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

papaya

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

n7822123

回復 6# papaya


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

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

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

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

sheets(1).delete
sheets(1).delete
sheets(1).delete

papaya

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

papaya

回復 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)

下載次數: 5

2020-7-28 01:17

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

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

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

papaya

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