[發問] 從一個儲存格資料，拆到多個儲存格欄位中

hugh0620

Dear 大大

          附件是我問題的範本，主要的問題有2
          1. 撰寫好後，在執行的時候，就會產生excel無反應的現象，該怎麼處理為好呢?
          2. 從一個儲存格內把資料拆到好幾個欄位，我寫的方式比較複雜(用判斷的方式一個字元一個字元來處理)
               不知道有沒有更好的處理方式呢???


eeeeeeeeeee.rar (17.63 KB)

範例
下載次數: 6

2014-9-25 10:47

Hsieh

回復 1# hugh0620

把你這筆資料要拆成怎樣的欄位用人工方式填入後上傳
以便了解你要的結果為何?

hugh0620

回復 2# Hsieh

Dear 大大

         附件是我修改好的，不知道有沒有更簡便的撰寫方式。
         (我自己有找到bug在哪邊，已經可以跑出我要的結果)
        另外有一句程式碼需要大大給點意見，如下句：
        patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
        現在的excel都有.xls 或 .xlsx ，如果用上面的句子只會顯示.xls的檔案
        要如何大小通吃把excel檔全叫出來呢???

eeee.rar (206.14 KB)

範本
下載次數: 9

2014-9-26 13:36

luhpro

回復  Hsieh
Dear 大大
另外有一句程式碼需要大大給點意見，如下句：
        patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
        現在的excel都有.xls 或 .xlsx ，如果用上面的句子只會顯示.xls的檔案
        要如何大小通吃把excel檔全叫出來呢???
hugh0620 發表於 2014-9-26 13:42

先回覆這一個 -
該函式的說明內就有答案了喔:

GetOpenFilename 方法
顯示標準的 [開啟舊檔] 對話方塊，並取得使用者檔案名稱，而不必真正開啟任何檔案。
expression.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
expression     必選。該運算式傳回 Application 物件。
FileFilter     選擇性的 Variant。是指定檔案篩選規則的字串。
此字串由一檔案篩選字串與 MS-DOS 萬用字元表達的檔案篩選規則描述組成，中間以逗點分隔。
[檔案類型] 下拉式清單方塊中會列出各組字串。例如，下列字串指定兩個檔案篩選，
文字和增益集：文字檔 (*.txt),*.txt,增益集檔案 (*.xla),*.xla。
若要使用多個 MS-DOS 萬用字元運算式組成單一檔案篩選類型，各萬用字元之間需以分號分隔；
例如，"Visual Basic Files (*.bas; *.txt),*.bas;*.txt"。
如果省略，則此引數將預設為 "All Files (*.*),*.*"。

所以你可以用:

patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls;*.xlsx), *.xls; *.xlsx")

來解決.

hugh0620

回復 4# luhpro


    謝謝指導~  長知識~ 以後就知道怎麼運用~  :)

luhpro

回復  Hsieh
Dear 大大
         附件是我修改好的，不知道有沒有更簡便的撰寫方式。
...
hugh0620 發表於 2014-9-26 13:42

eeee-a.zip (20.08 KB)

下載次數: 5

2014-9-27 12:45

22行以上的部分你可以考慮用你原來的方式,
看起來會比較簡單.
底下我只是嘗試著把它們都放入同一個迴圈內.

1. Private Sub CommandButton1_Click()
   
2.   Application.ScreenUpdating = False
   
3.   
   
4.   [B3].Resize(Rows.Count - 2, Columns.Count - 1).Clear
   
5.   lRow = 3
   
6.   bChk = False
   
7.   Do While Cells(lRow, 1) <> ""
   
8.     With Cells(lRow, 1)
   
9.       sStr = Trim(.Value)
   
10.       sChk = Left(sStr, 3)
    
11.       If sChk = "P/O" Then
    
12.         sPo = Mid(sStr, 9)
    
13.         .Offset(, 1) = sPo
    
14.         .Offset(, 2) = sPo
    
15.       ElseIf sChk = "COL" Then
    
16.         sCo = Mid(sStr, 6)
    
17.         .Offset(, 1) = sCo
    
18.         .Offset(, 2) = sPo
    
19.         .Offset(, 3) = sCo
    
20.         .Offset(-1, 3) = sCo
    
21.       Else
    
22.         .Offset(, 2) = sPo
    
23.         .Offset(, 3) = sCo
    
24.         iCnt = 0
    
25.         iPos = 1
    
26.         Do While iPos <= Len(sStr)
    
27.           If InStr(iPos, sStr, "(") <> 0 Then
    
28.             iPos = InStr(iPos, sStr, "(") + 1
    
29.             iCnt = iCnt + 1
    
30.           Else
    
31.             Exit Do
    
32.           End If
    
33.         Loop
    
34.         With .Offset(, 4)
    
35.           .Value = sStr
    
36.           .TextToColumns Space:=True
    
37.         End With
    
38.         .Offset(, 5 + iCnt).Resize(, 3).Cut .Offset(, 20)
    
39.          For iPos = 20 To 22
    
40.            .Offset(, iPos) = Val(.Offset(, iPos)) ' 後面計算會用到,所以先轉換成數值
    
41.          Next
    
42.         vNw1 = 0
    
43.         vNw2 = 0
    
44.         For iPos = iCnt - 1 To 0 Step -1
    
45.           With .Offset(, 5 + iPos)
    
46.             .Cut .Offset(, iPos * 2)
    
47.             With .Offset(0)
    
48.               .TextToColumns Other:=True, OtherChar:="("
    
49.               sStr = .Offset(, 1)
    
50.               With .Offset(, 1)
    
51.                 .NumberFormat = "@"
    
52.                 .Value = Left(sStr, Len(sStr) - 1)
    
53.               End With
    
54.             End With
    
55.           End With
    
56.           If iPos <> iCnt - 1 Then
    
57.             vNw1 = Round((.Offset(, 5 + iPos * 3) / .Offset(, 20)) * .Offset(, 21), 2)
    
58.             .Offset(, 7 + iPos * 3) = vNw1
    
59.             vNw2 = vNw2 + vNw1
    
60.           End If
    
61.         Next
    
62.         .Offset(, 4 + iCnt * 3) = .Offset(, 21) - vNw2
    
63.       End If
    
64.     End With
    
65.     lRow = lRow + 1
    
66.   Loop
    
67.   Application.ScreenUpdating = True
    
68. End Sub

複製代碼

Hsieh

回復 3# hugh0620

1. Sub ex()
   
2. For Each a In Range([A5], [A5].End(xlDown))
   
3. n = Split(a, "KGS")(0) '取到第一個KGS
   
4. mystr = Replace(Replace(Replace(Replace(Replace(n, "A", "A("), ")", "("), "YDS", "("), "KGS", "("), " ", "") '用左括號取代分隔位置
   
5. ar = Split(mystr, "(") '用左括號做分隔
   
6. y = Val(ar(UBound(ar) - 1)) 'YDS的值
   
7. k = Val(ar(UBound(ar))) 'KGS的值
   
8. s = UBound(ar)
   
9. Dim ay()
   
10. ReDim Preserve ay(0)
    
11. ay(0) = ar(0)
    
12. For i = 1 To (s - 2) / 2
    
13. x = UBound(ay) + 1
    
14. ReDim Preserve ay(x + 2)
    
15. n = (i - 1) * 2 + 1
    
16. ay(x) = Val(ar(n))
    
17. ay(x + 1) = "'" & ar(n + 1)
    
18. ay(x + 2) = Round(ar(n) / y * k, 2)
    
19. Next
    
20. a.Offset(, 4).Resize(, UBound(ay) + 1) = ay
    
21. Erase ay
    
22. Next
    
23. End Sub

複製代碼