Board logo

標題: [發問] 請教儲存格頡取文字並判斷的問題 [打印本頁]
作者: sujane0701    時間: 2011-3-21 03:16     標題: 請教儲存格頡取文字並判斷的問題

[attach]5072[/attach] 問題不容易用純文字說明,請大大們看檔案內容較容易明白小弟的問題
作者: ANGELA    時間: 2011-3-22 13:15

如果只要去除空白以後的文字用資料剖析即可,
用函數要做到你的要求太麻煩了,要定義太多名稱,還是影應前輩們一再講的正規化資料庫.較實在.
作者: sujane0701    時間: 2011-3-23 04:12

謝謝版主指導
比較無奈的是,資料來源是由客戶提供的 一小段 一小段 TXT文字檔,卻包含大量訊息,小弟也很苦惱
那能否請教,如果單一儲存格內EF000~EF003,是否有函數可以得出結果EF000,EF001,EF002,EF003 ?
作者: Hsieh    時間: 2011-3-23 09:53

本帖最後由 Hsieh 於 2011-3-23 12:03 編輯

回復 3# sujane0701


    這種不定數值的資料分解，要用內建函數達成是有困難的
建議使用VBA寫自定義函數來解決

試試自定義函數
[attach]5103[/attach]
作者: ANGELA    時間: 2011-3-23 10:45

本帖最後由 ANGELA 於 2011-3-23 10:46 編輯

回復 3# sujane0701


    參考看看
    定義名稱
     BX =MID(Sheet2!$C1,3,3)
    EX =IF(ISNUMBER(FIND("~",Sheet2!$C1)),MID(Sheet2!$C1,7,3),Sheet2!$C1)
    BEX =IF(LEN(ex)=2,ex-RIGHT(bx,2),ex-bx)
   [attach]5102[/attach]
   這種問題用VBA會理想些.
作者: GBKEE    時間: 2011-3-23 14:34

將資料顯示於 Sheet2
  1. Sub Ex()
  2.     Dim Ar, Ar1, E, A, R As Integer, C As Integer, S As Integer
  3.     R = 1
  4.     C = 1
  5.     Sheet2.Cells = ""
  6.     For Each E In Sheet1.Range("A1:C" & Sheet1.Range("A1").End(xlDown).Row).Rows
  7.         Sheet2.Cells(R, C) = E.Cells(1, 1) & "-" & E.Cells(1, 2)
  8.         Ar = Split(E.Cells(1, 3), " ")
  9.         If InStr(Ar(0), ",") Then
  10.             Ar = Split(Ar(0), ",")
  11.             For Each A In Ar
  12.                 If InStr(A, "~") Then
  13.                     Ar1 = Split(A, "~")
  14.                     R = R + 1
  15.                     S = Ar1(1) - Right(Ar1(0), Len(Ar1(1))) + 1
  16.                     Sheet2.Cells(R, C) = Ar1(0)
  17.                     Sheet2.Cells(R, C).AutoFill Sheet2.Cells(R, C).Resize(S)
  18.                     R = R + S - 1
  19.                 Else
  20.                     R = R + 1
  21.                     Sheet2.Cells(R, C) = A
  22.                 End If
  23.             Next
  24.         ElseIf InStr(Ar(0), ",") = False Then
  25.             If InStr(Ar(0), "~") Then
  26.                     Ar1 = Split(Ar(0), "~")
  27.                     R = R + 1
  28.                     S = Ar1(1) - Right(Ar1(0), Len(Ar1(1))) + 1
  29.                     Sheet2.Cells(R, C) = Ar1(0)
  30.                     Sheet2.Cells(R, C).AutoFill Sheet2.Cells(R, C).Resize(S)
  31.                     R = R + S - 1
  32.                 Else
  33.                     R = R + 1
  34.                     Sheet2.Cells(R, C) = Ar(0)
  35.                 End If
  36.         
  37.         End If
  38.         C = C + 1
  39.         R = 1
  40.     Next
  41. End Sub
複製代碼
作者: sujane0701    時間: 2011-4-4 01:32

真是太強了!!!謝謝各位版主大大指導,小弟試過都可以解決問題,另外Hsieh版主大大的函數自定義,小弟完全摸不到邊,努力蒐集資料學習這個好用的技能,再次感謝各位大大!!
作者: Andy2483    時間: 2023-5-17 10:19

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列,學習方案如下,請各位前輩指教

執行前:
[attach]36377[/attach]

執行結果:
[attach]36378[/attach]


Option Explicit
Sub TEST()
Dim Brr, Crr, Q, R&, C&, i&, j&, N&, S$, T$, T1$, T2$, P$, K%, K1%, M&
Brr = Range([C1], Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To 1000, 1 To UBound(Brr))
For i = 1 To UBound(Brr)
   T = Split(Brr(i, 3) & " ", " ")(0): R = 0
   R = R + 1: C = C + 1
   Crr(R, C) = Brr(i, 1) & "-" & Brr(i, 2)
   For Each Q In Split(T, ",")
      P = StrReverse(Q)
      K = InStr(P, "~") - 1
      S = StrReverse(Mid(Val(1 & Mid(P, K + 2)), 2))
      K1 = Len(S)
      If K > -1 Then
         T1 = Split(Q, "~")(0): T2 = Split(Q, "~")(1)
         N = Val(Right(T2, K)) - Val(Right(T1, K))
         For j = 0 To N
            R = R + 1: Crr(R, C) = Mid(StrReverse(T1), K1 + 1) & S + j
         Next
         Else
            R = R + 1: Crr(R, C) = Q
      End If
   Next
   If M < R Then M = R
Next
[H:K].ClearContents
[H1].Resize(M, C) = Crr
Erase Brr, Crr
End Sub



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