2016-06-14 56 views
0

我試圖在 柱上一個單獨的下列類型的數據:
1分之2814BBX,一分之二千八百一十四BBSDS,三分之二千八百八十五BBC NN,3分之2585COL BBC snnn獨立的數字和文本在單元格中

我想單獨將數值和文本值分成兩個不同的列,但如果文本包含「COL」,我想保留「COL」的數字部分。使用數據。例如,預期的結果將是:

列B爲:1分之2814,1分之2814,3分之2885,3分之2585COL 列C爲:BBX,BBSDS,BBCン,BBC snnn

我有以下代碼,但它將源文本分隔成多個列,並將數字部分與COL分隔開。

Sub SepNum() 
Dim N As Long, wf As WorksheetFunction 
Set wf = Application.WorksheetFunction 
N = Cells(Rows.Count, "A").End(xlUp).Row 
Dim i As Long, j As Long, k As Long 
For i = 1 To N 
    ary = Split(wf.Trim(Cells(i, "A").Text), " ") 
    k = 10 
    For j = LBound(ary) To UBound(ary) 
     Cells(i, k).Value = ary(j) 
     k = k + 1 
    Next j 
Next i 
End Sub 

回答

1

由於我們在空間性格分裂,我們必須保護空間先於COL

Sub SepNum() 
    Dim N As Long, wf As WorksheetFunction 
    Dim s As String 

    Set wf = Application.WorksheetFunction 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    Dim i As Long, j As Long, k As Long 
    For i = 1 To N 
     s = Replace(Cells(i, "A").Text, " COL", Chr(2) & "COL") 
     ary = Split(wf.Trim(s), " ") 
     Cells(i, 2).Value = Replace(ary(LBound(ary)), Chr(2), " ") 
     s = "" 
     For j = LBound(ary) + 1 To UBound(ary) 
      s = s & " " & ary(j) 
     Next j 
     Cells(i, 3).Value = wf.Trim(s) 
    Next i 
End Sub 

enter image description here

編輯#1:

如果COL具有多於一個空間之前,然後使用:

Sub SepNum3() 
    Dim N As Long, wf As WorksheetFunction 
    Dim s As String 

    Set wf = Application.WorksheetFunction 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    Dim i As Long, j As Long, k As Long 
    For i = 1 To N 
     s = wf.Trim(Cells(i, "A").Text) 
     s = Replace(s, " COL", Chr(2) & "COL") 
     ary = Split(wf.Trim(s), " ") 
     Cells(i, 2).Value = Replace(ary(LBound(ary)), Chr(2), " ") 
     s = "" 
     For j = LBound(ary) + 1 To UBound(ary) 
      s = s & " " & ary(j) 
     Next j 
     Cells(i, 3).Value = wf.Trim(s) 
    Next i 
End Sub 
+0

@你好加里,它的工作,但如果我們有兩個或更多的空間在COL前面是不是?? – Kuma

+0

@Kuma看我的**編輯#1 ** –

+0

@Garrys,謝謝你的時間。 – Kuma

1

看起來像所有的文本開始於BB?只有兩個部分?你有空間,你也試圖修剪,但不修剪,如果他們這樣做,你不會結束你的英國廣播公司樣本輸出nn - 你會得到BBCnn。 所以刪除數組循環,在BB處分割,然後將BB放回到字符串中。

Sub SepNum() 
Dim N As Long, wf As WorksheetFunction 
Set wf = Application.WorksheetFunction 
N = Cells(Rows.Count, "A").End(xlUp).Row 
Dim i As Long, j As Long, k As Long 
For i = 1 To N 
    ary = Split(wf.Trim(Cells(i, "A").Text), "BB") 
    k = 10 
    Cells(i, k).Value = ary(0) 
    Cells(i, k + 1).Value = "BB" + ary(1) 
    k = k + 1 
Next i 

End Sub 

或者,如果他們不都開始分裂BB在COL如果它存在,它重新進行添加到字符串的數字部分的結束。如果它不存在,在空間分割和限制分割爲2

Sub SepNum2() 
Dim N As Long, wf As WorksheetFunction 
Set wf = Application.WorksheetFunction 
N = Cells(Rows.Count, "A").End(xlUp).Row 
Dim i As Long, j As Long, k As Long 
For i = 1 To N 
    If InStr(wf.Trim(Cells(i, "A").Text), " COL ") > 0 Then 
     ary = Split(wf.Trim(Cells(i, "A").Text), " COL ", 2) 
     ary(0) = ary(0) + " COL" 
    Else 
     X = wf.Trim(Cells(i, "A").Text) 
     Y = Cells(i, "A").Text 
     ary = Split(wf.Trim(Cells(i, "A").Text), " ", 2)'the 2 limits the split to the first space 
    End If 
    k = 10 
    For j = LBound(ary) To UBound(ary) 
      Cells(i, k).Value = ary(j) 
      k = k + 1 
    Next j 
Next i 

End Sub 
+0

@羅傑,第二個工作沒有任何錯誤。謝謝。我試過這個公式來獲取數字,但它給出了錯誤的工作表(「Sheet2」)。Range(「H3」)。Value =「= LEFT(A3,FIND(」「,A3)-1)」??謝謝。 – Kuma

+0

如果您嘗試使用VBA將公式放入單元格中,您可以使用Worksheet(「Sheet2」)。Range(「H3」)。Formula =「= LEFT(A3,FIND(」「,A3)-1 )」。而不是。價值 – Rodger

0

首先,你不應該使用分裂,如果你只是想在一個位置來劃分的字符串,因爲這會在找到的每個空格處拆分字符串。 Id建議使用InStr()來查找該位置的COL位置(如果存在),然後還使用InStr()來查找應該將其分割的位置。另外,如果表單總是一致的(尤其是它的形式爲#### /#),那麼你可以做更聰明的字符串工作來完成這個任務。如果它始終是這種形式,那麼我的建議是首先檢查COL是否在字符串中。如果找不到(InStr返回0),那麼只需使用Left()Right()字符串函數簡單地分配B和C列中的值,知道它將總是按第7個值拆分(再次假設數字形式一致)。如果發現山口,然後從7 + 4的值分割字符串

+0

謝謝你的建議 – Kuma

0

一種替代,更靈活的方法可以是使用一個Regular Expression。這樣可以讓您在將來更改日期佈局或添加新需求時提供更大的靈活性。

下面是一個RegEx被封裝在返回匹配數組的函數中的一個示例。如果沒有匹配,它只是返回「不匹配」。它包括所有相同模式的可選COL

看看它是否可以幫助你。

Function ExtractVals(sInput As String) As Variant() 
    Dim oReg As Object 
    Dim vMatch() As Variant 
    Dim nCount As Integer 
    Set oReg = CreateObject("VBScript.Regexp") 

    With oReg 
     .IgnoreCase = True 
     .Global = True 
     .Pattern = "(\d*/*\d*\s*(?:COL)?)\s(\w*)" 
    End With 

    If Not oReg.test(sInput) Then 
     ReDim vMatch(0 To 0) 
     vMatch(0) = "No Match" 
    Else 
     With oReg.Execute(sInput)(0) 
      nCount = .submatches.Count - 1 
      ReDim vMatch(0 To nCount) 
      For i = 0 To nCount 
       vMatch(i) = .submatches(i) 
      Next i 
     End With 
    End If 

    ExtractVals = vMatch 
End Function 

Sub test() 
    Dim aMatches() 

    aMatches = ExtractVals(Range("A1").Value) 

    Range("B1").Resize(, UBound(aMatches) + 1).Value = aMatches 
End Sub 
0

嘗試用下面的代碼

Sub SepNum() 
    Dim N As Long 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    Dim i As Long, j As Long, k As Long 
    For i = 1 To N 
     fulllen = Len(Cells(i, 1)) 
     For j = 1 To fulllen 
      If (Asc(Mid(Cells(i, 1), j, 1)) >= 47 And Asc(Mid(Cells(i, 1), j, 1)) <= 57) Or (Asc(Mid(Cells(i, 1), j, 1)) = 44) Then 
       numerals = numerals & Mid(Cells(i, 1), j, 1) 
      Else 
       Text = Text & Mid(Cells(i, 1), j, 1) 
      End If 
     Next j 
     If InStr(Cells(i, 1), "COL") > 0 Then 
      numerals = numerals & " COL" 
      Text = Replace(Text, " COL ", "") 
     End If 
     Cells(i, 2) = numerals 
     Cells(i, 3) = Text 
    Next i 
End Sub 

enter image description here

相關問題