Board logo

標題: [發問] 從一個儲存格資料，拆到多個儲存格欄位中 [打印本頁]
作者: hugh0620    時間: 2014-9-25 10:48     標題: 從一個儲存格資料，拆到多個儲存格欄位中

Dear 大大

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


[attach]19228[/attach]
作者: Hsieh    時間: 2014-9-25 11:00

回復 1# hugh0620

把你這筆資料要拆成怎樣的欄位用人工方式填入後上傳
以便了解你要的結果為何?
作者: hugh0620    時間: 2014-9-26 13:42

回復 2# Hsieh

Dear 大大

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

[attach]19238[/attach]
作者: luhpro    時間: 2014-9-26 23:24

本帖最後由 luhpro 於 2014-9-26 23:26 編輯
回復  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    時間: 2014-9-27 09:14

回復 4# luhpro


    謝謝指導~  長知識~ 以後就知道怎麼運用~  :)
作者: luhpro    時間: 2014-9-27 12:45

本帖最後由 luhpro 於 2014-9-27 12:49 編輯
回復  Hsieh
Dear 大大
         附件是我修改好的，不知道有沒有更簡便的撰寫方式。
...
hugh0620 發表於 2014-9-26 13:42

[attach]19242[/attach]
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    時間: 2014-9-29 16:32

回復 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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)