emma

回復 60# GBKEE


     謝謝 GBKEE 版大，您的方式不完全是我想要的結果，我是用了最笨的方式繞了一大圈做出我要的結果
起先我是用「=SUBSTITUTE(A4,"0拾","")」這種方式，但run的時候一直出現sub相關字的錯誤，所以才改為Replace，
但不曉得 GBKEE 版大對我這樣的做法有無更好的建議，還有我為了比照顯示的結果，本來用
Sheets("工作表1").[B1] = t
Sheets("工作表1").[B2] = t1
↑這樣來對照不同的顯示結果，但不曉得為什麼這樣執行會有當掉的情形

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     '１２,３４５萬６千７百８十
   
4.     Dim Dot As Long, m As String, t As String, t1 As String
   
5.     m = "0萬0仟0佰0拾0"
   
6.     Dot = Sheets("工作表1").[A1]
   
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.     t = Format(Dot, m)
    
12.    'Sheets("工作表1").[B1] = Format(Dot, m)
    
13.     With Sheets("工作表1")
    
14.     t1 = Replace(t, "拾0", "拾")
    
15.     t1 = Replace(t1, "0拾0", "")
    
16.     t1 = Replace(t1, "0拾", "")
    
17.     t1 = Replace(t1, "0佰", "")
    
18.     Sheets("工作表1").[A4] = t1
    
19.     End With
    
20. End Sub

複製代碼

test2.rar (16.1 KB)

下載次數: 7

2013-5-1 21:04

Hsieh

回復 61# emma

下載 (62.08 KB)

2013-5-2 00:14

1. Function Read_Number(MyNum)
   
2. n = Right(MyNum, 4)
   
3. a = Array("拾", "百", "千")
   
4. k = Len(n)
   
5. i = k
   
6. Do Until i = 0
   
7.   If Val(Mid(n, i, 1)) > 0 And i < k Then
   
8.      m = Mid(n, i, 1) & a(j): j = j + 1
   
9.      ElseIf i = k Then
   
10.      m = IIf(Val(Mid(n, i, 1)) = 0, "", Mid(n, i, 1))
    
11.      Else
    
12.      m = IIf(Val(Mid(n, i, 1)) = 0, "零", Mid(n, i, 1) & a(j))
    
13.      j = j + 1
    
14.   End If
    
15.   t = m & t
    
16.   i = i - 1
    
17. Loop
    
18. For i = 3 To 2 Step -1
    
19.   t = Replace(t, String(i, "零"), "零")
    
20. Next
    
21. s = Val(Left(MyNum, Len(MyNum) - k))
    
22. Read_Number = IIf(s = 0, "", Format(Val(Left(MyNum, Len(MyNum) - k)), "#,##0萬")) & t
    
23. End Function

複製代碼

GBKEE

回復 61# emma

1. Option Explicit
   
2. Private Sub Ex()
   
3.     '１２,３４５萬６千７百８十
   
4.     Dim Dot As Long, m As String, t As String, i  As Integer
   
5.     m = "0萬0仟0佰0拾0 "         '加上一空格:處理個位數為0
   
6.     Dot = Sheets("工作表1").[A1]
   
7.     t = Format(Dot, m)
   
8.     For i = IIf(Len(t) > 10, 3, 1) To Len(m) Step 2
   
9.         'IIf(Len(t) > 10, 3, 1) 處理萬位數為0
   
10.         t = Replace(t, Mid(m, i, 2), "")
    
11.     Next
    
12.     Sheets("工作表1").[A4] = t
    
13.     'Sheets("工作表1").[A4] = RTrim(t)
    
14.     'LTrim、RTrim 與 Trim 函數
    
15.     '傳回一個沒有前頭空白 (LTrim)、後面空白 (RTrim) 或前後均無空白的Variant (String)，
    
16. End Sub

複製代碼

emma

各位前輩們好，因為當初這個檔案設計的時間已久，加上很多程式是依賴各位大大們協助完成的，所以有功能想要做新的異動，但想很久都試不出來，只好再厚著臉皮上來求助

附件中的『未出貨清單』工作表是從『查詢』工作表中的資料彙整過去的，以前是把同「活動狀態」及「品名」的筆數整合在同一列上，
現在想要每一筆都列出來，相同的資料如果大於二筆，就多一列小計幫忙計算筆數，最後總筆數是全部的加總。
不曉得是否能這麼設定，麻煩大大們了，謝謝^^


VBAtest13.rar (29.8 KB)

下載次數: 0

2016-5-17 19:25