123
返回列表 上一主題 發帖

[發問] 輸入資料比對資料表 轉換到別的資料表

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
11# 跳轉到 »
發表於 2016-10-16 02:46 | 只看該作者
本帖最後由 v03586 於 2016-10-16 02:51 編輯

回復 7# GBKEE


    感謝大大上面的程式碼...小弟茅塞頓開後....修改程式有出現 #8~#10樓的問題了!!!
    另已經將拉錯的Textbox 改為Listbox 了!!!
    如今有一個問題 想再請教版大  , 請求協助 !!
    不知道為何 , 查詢如圖片中的料號 , 會出現圖中的錯誤
   

    還有一個問題  因為『Database-回溫區』與『Database-氮氣櫃』的計算過期時間 應由 “ F欄位「 回溫後使用期限」“ 去優先計算 ( 目前都以 “H 欄位“ )
       僅有『Database-回溫區』與『Database-氮氣櫃』是以“H 欄位“
   因為想再查詢區顯示 距離過期天數, 無奈儲存格冰箱是在“ I 欄位“ 『回溫』 與『氮氣櫃』 皆在“ J 欄位“  , 如此一來 小弟犯難 不知如何修改了
   請求協助

   
   最後一個功能可有可無....就是『Database-回溫區』、『Database-回溫區』與『Database-氮氣櫃』
     排序之後不知道可否依照Film PN 去排優先取出順序???  當然還是要依照快過期的先拿
   EX:  
                PN           拿取順序
      40-111111       1
      40-111111       2
      40-111111       3
      40-222222       1
      40-222222       2
      40-222222       3

Film WIP Management_v1.rar (1013.66 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2016-10-16 14:00 | 只看該作者
本帖最後由 GBKEE 於 2016-10-17 07:22 編輯

回復 11# v03586

附檔 看看有意見再提出

Ex.zip (1.06 MB)
可修改如下 :可是只有一筆資料時它是直著放,不會橫放
  1. ReDim Ar(0 To UBound(D(Trim(TextBox2))))
  2.                 For i = 0 To UBound(D(Trim(TextBox2)))
  3.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
  4.                     If i = 2 Then Exit For  '顯示三筆
  5.                 Next
  6.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
複製代碼
方法一
  1. If D.Count > 0 And D.exists(Trim(TextBox2)) Then
  2.             If UBound(D(Trim(TextBox2))) = 0 Then
  3.                 Ar = D(Trim(TextBox2))(0)
  4.                 With ListBox1
  5.                     .AddItem
  6.                    For i = 0 To UBound(Ar)
  7.                         .List(.ListCount - 1, i) = Ar(i)
  8.                     Next
  9.                 End With
  10.             Else
  11.                 ReDim Ar(0 To 2)
  12.                 For i = 0 To UBound(D(Trim(TextBox2)))
  13.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
  14.                     If i = 2 Then Exit For  '顯示三筆
  15.                 Next
  16.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
  17.               End If
  18.         End If
複製代碼
方法二
  1. If D.Count > 0 And D.exists(Trim(TextBox2)) Then
  2.             'ReDim Ar(0 To UBound(D(Trim(TextBox2))))
  3.             If UBound(D(Trim(TextBox2))) = 0 Then
  4.                 'Ar = D(Trim(TextBox2))
  5.                 With Range("A" & Rows.Count).Resize(, UBound(D(Trim(TextBox2))(0)) + 1)
  6.                     .Value = D(Trim(TextBox2))(0)
  7.                     ListBox1.List = .Value
  8.                     .Cells.Clear
  9.                 End With
  10.             Else
  11.                 ReDim Ar(0 To 2)
  12.                 For i = 0 To UBound(D(Trim(TextBox2)))
  13.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
  14.                     If i = 2 Then Exit For  '顯示三筆
  15.                 Next
  16.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
  17.             End If
  18.         End If
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
13#
發表於 2016-10-19 03:27 | 只看該作者
本帖最後由 v03586 於 2016-10-19 03:32 編輯

回復 12# GBKEE


   感謝版大, 這幾天測試後, 有幾個小問題, 煩請版大協助
   1.  輸入格式部分修正
       工號, 因編碼關係 工號可以不要卡固定字元嗎? 有時會是4個數字組成 , 有時一個英文字母+3位數字, 有時兩個英文字母+2位數字
      不變的是都是四碼
      層架編號格式
     修正為 四碼 因應編碼關係, 可否也不要卡固定3位數字嗎??
     LOT 格式
      因為供應商關係每組LOT確定不會重覆, 但是LOT格式不一樣, 可否這邊就不卡格式呢??

2. 計算過期規則不一樣
    如下圖 , 冰箱的計算過期方式 是由 G欄位”膠紙到期日”去判斷距離現在還有多少天到期 ( 冰箱功能沒問題 )
   
    但是, 下圖 回溫區與氮氣櫃的計算方式不同, 是由F欄位『回溫後使用期限』,判斷距離現在還有多少天到期(回溫區, 與氮氣櫃 錯誤)
    冰箱資料表、回溫區資料表、氮氣櫃資料表 三張資料表格式僅差一欄『回溫後使用期限』


3. 查詢先進先出功能
    查詢冰箱中的距離過期天數, 程式跑成優先拿取順序了 ( 因為資料表只有冰箱格式與其他兩張資料表沒有一樣 ) 如下圖
   至於回溫區與氮氣櫃目前顯示的都是正確的, 只是如Q2問題, 計算位置修改好 就解決問題了
   

   部分查詢料號會無法帶出資料 , 如下圖
   

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2016-10-19 06:56 | 只看該作者
回復 13# v03586

不限制格式 Msg = St <> ""
回溫區與氮氣櫃的計算方式不同, 是由F欄位『回溫後使用期限』,判斷距離現在還有多少天到期
可改如下
  1. Sub Ex_Ans()
  2.     Dim St As String, I(1 To 3) As Integer, d As Object, E As Variant, Rng As Range, Ar(), Arr()
  3.     With Sh
  4.         St = "膠紙製造日"
  5.         I(1) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column
  6.         .Columns(I(1)).TextToColumns Destination:=.Cells(1, I(1)), DataType:=xlDelimited, _
  7.             FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True  '***(文字格式, 轉換為日期)
  8.         
  9.         ' **傳回膠紙到期日的欄位  或  回溫後使用期限 的欄位
  10.         If InStr(Sh.Name, "冰箱") Then St = "膠紙到期日" Else St = "回溫後使用期限"
  11.         I(1) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column '**傳回膠紙到期日的欄位
  12.         If St = "回溫後使用期限" Then
  13.             Application.Calculation = xlManual      '活頁簿的計算: 手動
  14.             With .Columns(I(1)).SpecialCells(xlCellTypeConstants)
  15.                 .Cells = .Value                                  '** 文字格式的數字 轉為數值
  16.             End With
  17.             Sh.Calculate               '**Calculate 方法  計算所有開啟的活頁簿、活頁簿中的特定工作表或工作表中指定範圍的儲存格.
  18.             Application.Calculation = xlAutomatic  '活頁簿的計算: 自動
  19.         End If
  20.         If InStr(Sh.Name, "冰箱") Then
  21.             .Columns(I(1)).TextToColumns Destination:=.Cells(1, I(1)), DataType:=xlDelimited, _
  22.             FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True  '***(文字格式, 轉換為日期)
  23.         End If
  24.         St = "距離過期天數"
  25.         I(2) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column
  26.         If .Range("a" & Rows.Count).End(xlUp).Row = 1 Then Exit Sub
複製代碼
3. 查詢先進先出功能 部分查詢料號會無法帶出資料 在11# 有回覆 方法一,方法二
這裡修改
  1. Private Sub ComboBox2_Change()
  2.     Dim Rng As Range, Ar, I As Integer
  3.     With ListBox1
  4.         .Clear
  5.         If ComboBox2.ListIndex = -1 Then Exit Sub
  6.         Ar = Dt(ComboBox2.Value)
  7.         If UBound(Ar) = 0 Then
  8.             .AddItem
  9.             For I = 0 To UBound(Ar(0))
  10.                 .List(0, I) = Ar(0)(I)
  11.             Next
  12.         Else
  13.             .List = Application.Transpose(Application.Transpose(Ar))
  14.         End If
  15.     End With
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
15#
發表於 2016-10-19 07:19 | 只看該作者
本帖最後由 v03586 於 2016-10-19 07:33 編輯

回復 14# GBKEE


    感謝版大!!! 終於解決了!!!

但問題3當中, 查詢先進先出, 冰箱, 距離過期天數一樣還是顯示『優先拿取順序』, 資料表-冰箱『J欄位』 正確應該顯示『I欄位』
  因為資料表回溫區與氮氣櫃, 正確要顯示『J欄位』

另外目前距離過期天數跑出小數點好幾位, 可否顯示小數點後一位就好呢??

不限制格式
請問是這樣修改即可嗎???
  1. Private Sub TextBox4_Change()
  2.     Dim St As String, Msg As Boolean, I As Integer, Ar

  4.     Msg = St <> ""
  5. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2016-10-19 08:51 | 只看該作者
回復 15# v03586
  1. Private Sub TextBox4_Change()
  2.      Dim St As String, Msg As Boolean
  3.         St = Trim(TextBox4)
  4.         Msg = St <> ""
  5.        TheMsg 4, Msg
  6. End Sub
複製代碼
  1. Private Sub Lot_Get()
  2.     Dim I As Long, St As String, B As String, C As String, d As String, Ar(), X As Integer
  3.     Set Dt = CreateObject("ScripTING.DICTIONARY")
  4.     'X = IIf(InStr(ActiveSheet.Name, "冰箱"), 9, 10)
  5.     With Sh
  6.         X = IIf(InStr(.Name, "冰箱"), 9, 10)
  7.         I = ShRow
  8.         Do While .Cells(I, "C") <> ""
  9.             B = .Cells(I, "B"):    C = .Cells(I, "C"):  d = .Cells(I, "D"):    St = Format(.Cells(I, X), "0.0")
  10.             If Not Dt.EXISTS(C) Then
  11.                 Dt(C) = Array(Array(B, C, d, St))
  12.             Else
  13.                 Ar = Dt(C)
  14.                 ReDim Preserve Ar(LBound(Ar) To UBound(Ar) + 1)
  15.                 Ar(UBound(Ar)) = Array(B, C, d, St)
  16.                  Dt(C) = Ar
  17.                  Ar = Dt(C)
  18.             End If
  19.             I = I + 1
  20.         Loop
  21.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
17#
發表於 2016-10-19 12:42 | 只看該作者
本帖最後由 v03586 於 2016-10-19 12:43 編輯

回復 16# GBKEE


    感謝版大...!! 現如今改掉限制後發現一個問題
   Lot 部分 只能Keyin 一個字元 就往下一格跳
   即使使用刷條碼的方式 , 例如 EE000-0001 , Lot 格式就只帶E , PCS 那欄會跳E000-0001
   回溫後使用期限的時間格式 , 也無法手動修改 如下圖 , 修改一個數字就往下一格跳

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 2016-10-19 12:47 | 只看該作者
本帖最後由 GBKEE 於 2016-10-20 05:06 編輯

回復 17# v03586
  1. Private Sub TheMsg(T As Integer, Msg As Boolean)   ''** 程式作用  資料輸入格式的檢查
  2.     '** 乎叫此程式 須帶有 參數1   ,參數2
  3.     Dim St As String
  4.     Text_Ar(T).BackColor = IIf(Msg, 正常色, 錯誤色)
  5.     Text_Msg(T) = Msg
  6.     ComButton_檢查
  7.     If ComButton.Enabled Then ListBox1_Change
  8.     If ComButton.Enabled Then
  9.         ComButton.SetFocus          '**SetFocus 方法 將駐點移到此物件的執行個體上。
  10.     ElseIf Msg Then                     '**輸入格式的正確 下移至下一個控制項
  11. '*****************這裡試著修改 ****************************
  12.         If T > 2 And T <> 5 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
  13. '********************************************************
  14.     End If
  15. End Sub
複製代碼
回溫後使用期限 格式 與 放入時間格式 Private Sub TextBox9_Change() 是相同的
  1. Private Sub TextBox6_Change()
  2.    Dim St, Msg As Boolean, Ar
  3.    '格式  日期&時間
  4.     St = Trim(TextBox6)
  5.     Msg = UBound(Split(St, "/")) = 2 And UBound(Split(St, " ")) = 1 And UBound(Split(St, ":")) = 1: If Not Msg Then GoTo Ne
  6.     Ar = Split(St, " ")
  7.     Msg = IsDate(Ar(0)): If Not Msg Then GoTo Ne
  8.     Msg = IsDate(Ar(1)): If Not Msg Then GoTo Ne
  9.     If Msg Then TextBox6 = Format(TextBox6, 日期時間格式)
  10. Ne:
  11.     TheMsg 6, Msg
  12. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
19#
發表於 2016-10-19 13:27 | 只看該作者
回復 18# GBKEE


    版大, 我有修改過 工號 跟 層架編號解除限制 , 不知道是否影響那一欄的判斷
工號
  1. Private Sub TextBox1_Change()          '** 控制項有變動 : 程式作用  資料格式 的檢查
  2.     Dim St As String, Msg As Boolean, I As Integer
  3.     St = Trim(TextBox1)
  4.     Msg = St <> "" And Len(St) > 1: If Not Msg Then GoTo Ne   '**Msg=False 程式移到 Ne 繼續執行
  5. Ne:
  6.      TheMsg 1, Msg
  7. End Sub
複製代碼
層架編號
  1. Private Sub TextBox2_Change()
  2.    Dim St As String, Msg As Boolean
  3.     St = Trim(TextBox2)
  4.     Msg = St <> ""
  5.     TheMsg 2, Msg
  6. End Sub
複製代碼
接下來Lot 是依照版大所以修改的

如下版大請我嘗試修改的範圍
  1. Private Sub TheMsg(T As Integer, Msg As Boolean)   ''** 程式作用  資料輸入格式的檢查
  2.     '** 乎叫此程式 須帶有 參數1   ,參數2
  3.     Dim St As String
  4.     Text_Ar(T).BackColor = IIf(Msg, 正常色, 錯誤色)
  5.     Text_Msg(T) = Msg
  6.     ComButton_檢查
  7.     If ComButton.Enabled Then ListBox1_Change
  8.     If ComButton.Enabled Then
  9.         ComButton.SetFocus          '**SetFocus 方法 將駐點移到此物件的執行個體上。
  10.     ElseIf Msg Then                     '**輸入格式的正確 下移至下一個控制項
  11. '*****************這裡試著修改 ****************************
  12.         If T > 2 And T <> 5 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
  13. '********************************************************
  14.     End If
  15. End Sub
複製代碼
我修改了 紅色字體 , 變成PCS一個字元就跳去下一格, 回溫後使用期限 , 點兩下變成1899年...也是修改一個數字就跳去下一個
  If T > 1 And T <> 4 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus

我修改了 紅色字體 , 變成LOT、回溫後使用期限修改 一個字元就跳去下一格, 回溫使用期限點兩下變成1899年...
可否將膠紙製造日, 到期日 不卡規則呢?? 因為也是刷條碼, 廠商條碼格式就像當初的一樣是字元格式 ”20171011” , 再由程式去轉換時間格式
  If T > 3 And T <> 6 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
20#
發表於 2016-10-20 05:42 | 只看該作者
本帖最後由 GBKEE 於 2016-10-20 05:54 編輯

回復 19# v03586
回溫使用期限點兩下變成1899年...
修改這裡
  1. Sub 放入冰箱()   'Input 冰箱 (資料存入『Database-冰箱』)
  2.     Set Sh = Sheets("Database-冰箱")
  3.     回溫後使用期限 = Now + 2       '**給值
  4.     Com_Title = " [ 放入冰箱 ]"
  5.     Form_InPut.Show
  6. End Sub
複製代碼
  1. If T = 3 Or T >= 6 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
  2.         '** 1工號 , 2層架編號 , 4LOT, 5PCS  **不設格式不跳到下一輸 入控制項
  3.         '**3Film P/N , 6回溫後使用期限, 7膠紙製造日 8 膠紙到期日 **'跳到下一輸 入控制項
  4.         '** 9 放入時間=>Text_Ar(T + 1).SetFocus 會有錯誤的
複製代碼
工號 跟 層架編號....   解除限制
  1. Private Sub TextBox1_Change()          '** 控制項有變動 : 程式作用  資料格式 的檢查
  2.      '**不限制格式
  3.      TheMsg 1, Trim(TextBox1) <> ""   '不限制格式
  4. End Sub
複製代碼
設定條碼格式
  1. Private Sub TextBox7_Change()
  2.     '格式  條碼 8 位數
  3.     Dim St(1 To 2) As String, Msg As Boolean, Ar
  4.     St(1) = Trim(TextBox7)
  5.     Msg = Len(St(1)) = 8 And IsNumeric(St(1)): If Not Msg Then GoTo Ne
  6.     St(2) = Mid(St(1), 1, 4) & "/" & Mid(St(1), 5, 2) & "/" & Mid(St(1), 7, 2)
  7.     Msg = IsDate(St(2)): If Not Msg Then GoTo Ne         '**日期正確
  8.     Msg = DateValue(St(2)) < Date: If Not Msg Then GoTo Ne    '**膠紙製造日必小於當日
  9. Ne:
  10.     TheMsg IIf(Label6.Enabled, 7, 6), Msg
  11. End Sub
  12. Private Sub TextBox8_Change()
  13.      '格式  條碼 8 位數
  14.     Dim St(1 To 3) As String, Msg As Boolean, Ar
  15.    St(1) = Trim(TextBox8)
  16.     Msg = Len(St(1)) = 8 And IsNumeric(St(1)): If Not Msg Then GoTo Ne
  17.     St(2) = Mid(St(1), 1, 4) & "/" & Mid(St(1), 5, 2) & "/" & Mid(St(1), 7, 2)  '膠紙到期日
  18.     Msg = IsDate(St(2)): If Not Msg Then GoTo Ne
  19.     Msg = Text_Msg(IIf(Label6.Enabled, 7, 6)): If Not Msg Then GoTo Ne '膠紙製造日是否正確
  20.     St(3) = Trim(TextBox7)
  21.     St(3) = Mid(St(3), 1, 4) & "/" & Mid(St(3), 5, 2) & "/" & Mid(St(3), 7, 2)  '**'膠紙製造日
  22.     Msg = DateValue(St(2)) > DateValue(St(3))                       '**膠紙到期日必大於膠紙製造日
  23. Ne:
  24.     TheMsg IIf(Label6.Enabled, 8, 7), Msg
  25. End Sub
  26. '**設定條碼格式 後需修改
  27. Private Sub ComButton_Click()          '**控制項的事件 (按下控制項)
  28.     Dim i As Integer, XR As Integer
  29.     If MsgBox(Join(Text_Ar, vbLf), vbYesNo, "   ** 確定 " & Com_Title & "  **") = vbYes Then
  30.         '**Join 函數 傳回一個字串 , 該字串是透過連結某個陣列中的多個子字串而建立的
  31.         XR = Application.CountA(Sh.[A:A])
  32.         With Sh.Range("A" & XR).Offset(1)
  33.             For i = 1 To UBound(Text_Ar)               '**UBound 函數 傳回 Long值，表示指定陣列某維最大可使用的陣列索引。
  34.                  If InStr(Sh.Name, "冰箱") And (i = 6 Or i = 7) Then
  35.                     .Cells(1, i) = Mid(Text_Ar(i), 1, 4) & "/" & Mid(Text_Ar(i), 5, 2) & "/" & Mid(Text_Ar(i), 7, 2)
  36.                  ElseIf InStr(Sh.Name, "冰箱") = 0 And (i = 7 Or i = 8) Then
  37.                     .Cells(1, i) = Mid(Text_Ar(i), 1, 4) & "/" & Mid(Text_Ar(i), 5, 2) & "/" & Mid(Text_Ar(i), 7, 2)
  38.                  Else
  39.                     .Cells(1, i) = UCase(Text_Ar(i).Text)  '**UCase 函數 傳回一個 Variant (String)，所含為轉成大寫之字串。
  40.                 End If
  41.             Next
  42.         End With
  43.         DataBase_Show
  44.     End If
  45.     ListBox1_Change
  46. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事，就等於壽命有多長。因此必須與時間競爭，切莫使時日空過。
123
返回列表 上一主題