2014-12-13 184 views
-1

我試圖找出如何將文本循環到列代碼。希望得到它的循環,直到最後的數據或可能是空的行/單元格。儘管我可能有超過60份材料清單。感謝任何人都可以幫忙。 :)Excel VBA'文本到列'循環

'Material 1 
 
Range("A2").Select 
 
Selection.TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _ 
 
TrailingMinusNumbers:=True 
 
Range("A3").Select 
 
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _ 
 
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True 
 
Range("A4").Select 
 
Selection.TextToColumns Destination:=Range("O2"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _ 
 
:=True 
 

 

 

 

 
'Material 2 
 
Range("A5").Select 
 
Selection.TextToColumns Destination:=Range("B5"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _ 
 
TrailingMinusNumbers:=True 
 
Range("A6").Select 
 
Selection.TextToColumns Destination:=Range("F5"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _ 
 
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True 
 
Range("A7").Select 
 
Selection.TextToColumns Destination:=Range("O5"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _ 
 
:=True 
 

 

 
'Material 3 
 
Range("A8").Select 
 
Selection.TextToColumns Destination:=Range("B8"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _ 
 
TrailingMinusNumbers:=True 
 
Range("A9").Select 
 
Selection.TextToColumns Destination:=Range("F8"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _ 
 
Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True 
 
Range("A10").Select 
 
Selection.TextToColumns Destination:=Range("O8"), DataType:=xlFixedWidth, _ 
 
FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _ 
 
:=True

回答

0

試試這個。它非常笨重,但應該遵循循環一列數據的模式,並根據循環當前所在的每個部分中的三行中的哪一行執行TextToColumn轉換。

這裏是僞代碼邏輯,基於你的例子:

  1. 如果行1個輸出「B」
  2. 如果行2列輸出「F」
  3. 如果行3列輸出「O」 ......重複步驟每個部分1-3個

這裏的VBA:

Sub TextToColumnLoop() 

    'Set up the variables 
    Dim DataCol As String 
    Dim Row1Col, Row2Col, Row3Col As String 
    Dim FirstRow, LastRow As Integer 
    Dim ctr As Integer 

    'Your variables (change these to whatever you want) 
    '--This enables you to re-use this code and apply it to different data ranges 
    DataCol = "A" '= the column where your data is 
    Row1Col = "B" '= the column where you want the row 1 data outputted 
    Row2Col = "F" '= the column where you want the row 2 data outputted 
    Row3Col = "O" '= the column where you want the row 3 data outputted 
    FirstRow = 2 '= cell "A2" in this example 
    LastRow = 10 '= cell "A10" in this example --**NOTE:use this to statically set the last row 
    ctr = 1   'start on row "1" of the current section 

    '**NOTE: Use this while loop to dynamically set the last row in your range (as opposed to the var being set statically, above) 
    'While loop to find the active range (loops as long as the cells aren't empty) 
    i = FirstRow 
    While Me.Range(DataCol & i) <> "" 
     i = i + 1 
    Wend 

    'Set the last non-empty cell as the last cell in the range 
    LastRow = i - 1 

    'Loop through your rows 
    For i = FirstRow To LastRow 

     If ctr = 1 Then 

      'TextToColumn for Row 1 
      Me.Range(DataCol & i).TextToColumns _ 
      Destination:=Range(Row1Col & i), _ 
       DataType:=xlFixedWidth, _ 
       FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _ 
       TrailingMinusNumbers:=True 

      'Increment row counter 
      ctr = ctr + 1 

     ElseIf ctr = 2 Then 

      'TextToColumn for Row 2 
      Me.Range(DataCol & i).TextToColumns _ 
      Destination:=Range(Row2Col & i), _ 
       DataType:=xlFixedWidth, _ 
       FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), _ 
        Array(40, 1), Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), _ 
       TrailingMinusNumbers:=True 

      'Increment row counter 
      ctr = ctr + 1 

     ElseIf ctr = 3 Then 

      'TextToColumn for the Row 3 
      Me.Range(DataCol & i).TextToColumns _ 
      Destination:=Range(Row3Col & i), _ 
       DataType:=xlFixedWidth, _ 
       FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), _ 
       TrailingMinusNumbers:=True 

      'Reset row counter 
      ctr = 1 

     End If 

    Next i 

End Sub 

確保您將在工作表對象的代碼在VBEditor爲具有您的數據的工作表。因爲它使用Me.Range()(即,其中「Me」=當前工作表)的語法,而不是表格(「Sheet1」)。範圍()工作表名稱被明確命名。

如果你感到困惑了我的意思,當我說「工作表對象」與「模塊」,然後檢查出的截圖here

+0

感謝您的幫助!非常感謝。將很快嘗試此代碼,並讓您知道結果。並會檢查出截圖。 – Zawawi 2014-12-14 03:25:57

0

其實我已經解決了這個我自己的,但由於我對於VBA來說真的很新穎(就像一個月前剛剛開始瞭解VB一樣),所以我不確定代碼的效率如何,或者是否有更好的方法來實現它。我根據網絡上的一些研究做到了這一點。但即時通訊戈納嘗試的內容已被mb2011建議看看我能在那裏學習:)

Dim LastRowA As Long 
 
Dim i As Long 
 
Dim j As Long 
 
Dim p As Long 
 

 
    
 

 
LastRowA = Range("A" & rows.Count).End(xlUp).Row 
 
    
 
    
 
    'Looping first line starting Range A2 
 
    For i = 2 To LastRowA Step 3 'step 3 to count every 3rd row 
 
     Cells(i, 1).TextToColumns Destination:=Cells(i, 2), DataType:=xlFixedWidth, _ 
 
     FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(58, 1), Array(65, 1)), _ 
 
     TrailingMinusNumbers:=True 
 
    Next i 
 
    
 
    'Looping second line Range A3 
 
    For j = 3 To LastRowA Step 3 
 
    Cells(j, 1).TextToColumns Destination:=Cells(j - 1, 6), DataType:=xlFixedWidth, _ 
 
     FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(25, 1), Array(37, 1), Array(40, 1), _ 
 
     Array(43, 1), Array(54, 1), Array(64, 1), Array(73, 1)), TrailingMinusNumbers:=True 
 
    Next j 
 

 
    'Looping third line Range A4 
 
    For p = 4 To LastRowA Step 3 
 
    Cells(p, 1).TextToColumns Destination:=Cells(p - 2, 15), DataType:=xlFixedWidth, _ 
 
     FieldInfo:=Array(Array(0, 9), Array(26, 1), Array(63, 1)), TrailingMinusNumbers _ 
 
     :=True 
 
    Next p