emma

回復 50# GBKEE


    GBKEE版大，您好，想再向您請教一下，可否於開啟excel時，先設定一視窗跳出讓使用人選擇「店別」及「經辦」，設定完成之後，
    其店別的相關設定是為了取代現有的【查詢】工作表中的B1，然後想再多一工作表【當日訂單明細】，但還是無法自行修改成想要的結果，
    如【當日訂單明細-手動結果】的樣子，所以再厚顏上來請教，謝謝您^^

VBAtest14.rar (30.52 KB)

下載次數: 4

2013-1-2 14:17

GBKEE

回復 51# emma
試試看

test.rar (31.47 KB)

下載次數: 9

2013-1-2 17:41

emma

回復 52# GBKEE


     GBKEE版大，您好，又有一個新的想法想請教您，如果說想要讓使用者輸入完一筆資料之後，就跳出視窗顯示部份訊息的話，
不曉得怎麼把相關的顯示結果帶到TextBox裡，謝謝您^^

下載 (241.27 KB)

2013-4-22 15:35

VBAtest15.rar (32.51 KB)

下載次數: 6

2013-4-22 15:39

GBKEE

回復 53# emma

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String, s As Integer, dot As Long, K As Integer, M As String, t As String
   
4.     Dim Ar(), A As Range, Rng As Range
   
5.     If Target.Address(0, 0) = "E1" Then
   
6.         Range("D3").AutoFilter Field:=4, Criteria1:="*" & Target & "*"
   
7.     ElseIf Target.Address(0, 0) = "C1" Then
   
8.         Range("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
   
9.     End If
   
10.     Application.EnableEvents = False              '****
    
11.     Set Rng = Range("B4:B65536").SpecialCells(xlCellTypeVisible)     '自動篩選後可見的儲存格
    
12.     If Application.Count(Rng) > 0 Then                                                      '可見的儲存格:有資料儲存格的總數>0
    
13.         Set Rng = Rng.SpecialCells(xlCellTypeConstants)                         '可見的儲存格:有資料的儲存格
    
14.             For Each A In Rng.Cells
    
15.              ReDim Preserve Ar(s)
    
16.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
17.                 K = IIf(Sheets("查詢").[b1] = "總店", 10, 11)
    
18.                 If A.Offset(, 7) < Date Then
    
19.                     M = "已結束"
    
20.                     t = "已出貨"
    
21.                 ElseIf A < A.Offset(, 4) Then
    
22.                     M = "運費+手續費"
    
23.                     t = "未出貨"
    
24.                 ElseIf InStr(A.Offset(, 5), "推") And A > A.Offset(, 4) Then       '包含
    
25.                     M = "免運"
    
26.                     t = "未出貨"
    
27.                 ElseIf InStr(A.Offset(, 5), "推") = 0 And A > A.Offset(, 4) Then   '不包含
    
28.                     M = "運費"
    
29.                     t = "未出貨"
    
30.                 End If
    
31.                 Ar(s) = Array(A.Offset(, 2).Value, A.Value, A.Offset(, 3).Value, dot, A.Offset(, 12).Value, A.Offset(, K).Value, M, A.Offset(, 6).Value, A.Offset(, 7).Value, t)
    
32.                 s = s + 1
    
33.             Next
    
34.             With UserForm2
    
35.                 .TextBox1 = Ar(s - 1)(0)
    
36.                 .TextBox2 = dot
    
37.                 .TextBox3 = M
    
38.                 .Show
    
39.             End With
    
40.         End If
    
41.     With Sheets("查詢")
    
42.         If s > 0 And UserForm2.Msg = False Then
    
43.             Target = ""
    
44.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 10) = Application.Transpose(Application.Transpose(Ar))
    
45.             .Range("A4").CurrentRegion.Sort Key1:=.[A4], Header:=xlYes
    
46.              Sheets("資料檔").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'F欄:儲位
    
47.         End If
    
48.     End With
    
49.     Application.EnableEvents = True                 '*******
    
50. End Sub

複製代碼

1. Public Msg As Boolean   '按下 [取消] 的公用變數
   
2. Private Sub CommandButton1_Click()
   
3.     UserForm2.Hide
   
4. End Sub
   
5. 'UserForm2 須增加一CommandButton2  '取消按鈕
   
6. Private Sub CommandButton2_Click()  
   
7.     Msg = True                               ''按下 [取消] 按鈕為 True
   
8.     UserForm2.Hide
   
9. End Sub
   
10. Private Sub UserForm_Activate()  'UserForm 顯示時
    
11.       Msg = False                '取消 [取消]按鈕
    
12. End Sub

複製代碼

emma

回復 54# GBKEE

    謝謝 GBKEE 版大，另外有個小問題想再請教一下，就是累積點數的表示方式.TextBox2可以顯示出,千分位的符號嗎?例「1,234,567,890] 這樣
    或者是說想顯示「1萬2仟3佰4拾5點」這種表示方式，可以嗎?
   

下載 (14.38 KB)

2013-4-24 12:17

GBKEE

回復 55# emma

1.             With Cells(Rows.Count, Columns.Count)
   
2.                 .Value = dot
   
3.                 .NumberFormatLocal = "[DBNum1][$-404]G/通用格式" '小寫國字
   
4.                 '.NumberFormatLocal = "[DBNum2][$-404]G/通用格式" '大寫國字
   
5.                 '.NumberFormatLocal = "#,##0_);[紅色](#,##0)"     '千分位
   
6.             End With
   
7.             With UserForm2
   
8.                 .TextBox1 = Ar(s - 1)(0)
   
9.                 .TextBox2 = Cells(Rows.Count, Columns.Count).Text
   
10.                 .TextBox3 = M
    
11.                 .Show
    
12.             End With

複製代碼

emma

回復 56# GBKEE

   非常謝謝 GBKEE 版大，真的幫了大忙了，關於「'.NumberFormatLocal = "[DBNum2][$-404]G/通用格式" '大寫國字」
   這個部份想再做更細一點的詢問，如果是1,234,567,890的話，以「"[DBNum3][$-404]G/通用格式"」套用後
   顯示結果為「１億２千３百４十５萬６千７百８十９」，但實際上，要一部份數字一部份國字的原因只是為了讓使用人員好讀取，
   不用一個個以個、拾、佰、仟、萬的數上去才得知總共是多少的點數，但可以只顯示國字到萬就好嗎?
   例「１億２千３百４十５萬６千７百８十９」→「１２,３４５萬６千７百８十９」
   ↑可以這樣嗎?謝謝您了^^

GBKEE

回復 57# emma

1. Option Explicit
   
2. Sub EX()
   
3.     '１２,３４５萬６千７百８十
   
4.     Dim Dot As Long, m As String
   
5.     Dot = 123456789
   
6.     m = "000萬0千0百0十0"
   
7.     If Len(CStr(Dot)) = 1 Then m = "0"
   
8.     If Len(CStr(Dot)) = 2 Then m = "0十0"
   
9.     If Len(CStr(Dot)) = 3 Then m = "0百0十0"
   
10.     If Len(CStr(Dot)) = 4 Then m = "0千0百0十0"
    
11.     MsgBox Format(Dot, m)
    
12. End Sub

複製代碼

emma

回復 56# GBKEE


    謝謝 GBKEE 版大，那如果只想抓，仟跟萬就好，例如「123,000」就只顯示「12萬3仟」，現在的是「12萬3仟0佰0拾0」，那些"0"有辦法省略嗎?
   如果不是用程式，而是一般的儲存格格式有辦法用函數之類的達到類似的設定嗎?還是就只能用vba去達到這種顯示效果?!
   真的非常感謝您不厭其煩的回覆我的小問題^^

GBKEE

回復 59# emma

1. Option Explicit
   
2. Sub EX()
   
3.     '１２,３４５萬６千７百８十
   
4.     Dim Dot As Long, m As String
   
5.     Dot = Int(123456789 / 1000)
   
6.     m = "0萬0千"
   
7.     MsgBox Format(Dot, m)
   
8. End Sub

複製代碼