VBA複製細胞循環

Question

我充滿了用空格分隔，如串細胞列：

"abc def ghi jkl" 
"abcde fghi jkl" 
"abcdef ghijkl" 
"abcdefghijkl" 

我的目標是：

1. 當有四個字我把每一個第一每個單詞的字母
2. 當有三個單詞時，我將第一個單詞的前兩個字母，然後是下列單詞的每個第一個字母
3. 當我有兩個單詞時每個字
4. 當只有一個單詞的前兩個字母我走的前四個字母

因爲我發現複製到同一行的另一個細胞所產生的四個字母每一種情況下。

作爲vba的新手，我並沒有走得太遠。我從案例1開始，但它不完整，沒有任何回報：

Sub MyMacro() 

Dim r As Range 
Dim a, b, c, d, s As String 
Dim v As Variant 
Dim w As Worksheet 

Set w = Worksheets("Sheet1") 
w.Activate 
Set r = w.Range("B1").End(xlDown).Rows 

    For Each v In r.Cells 

     If UBound(Split(v, " ")) = 3 Then 
      a = Left(Split(v, " ")(0), 1) 
      b = Left(Split(v, " ")(1), 1) 
      c = Left(Split(v, " ")(2), 1) 
      d = Left(Split(v, " ")(3), 1) 
     End If 

    Next 

End Sub 

爲什麼不是a，b，c和d不返回任何東西？

雖然我通過一系列的細胞循環，我怎麼說，我要一個，b，c和d的連接值複製到相鄰的單元格？

編輯爲用「」替換「@」。

Answer 1

Sub MyMacro() 

Dim r As Range 
Dim a, b, c, d, s As String 
Dim v As Variant 
Dim w As Worksheet 
Dim arr, res 

Set w = Worksheets("Sheet1") 
w.Activate 
Set r = w.Range(w.Range("B1"), w.Range("B1").End(xlDown)) 

    For Each v In r.Cells 
     arr = Split(v.Value, " ") 
     select case ubound(arr) 
      case 0: res=left(arr(0),4) 
      case 1:'etc 
      case 2:'etc 
      case 3:'res = left(arr(0),1) & left(arr(1),1)'...etc 
      case else: res = "???" 
     End Select 
     v.offset(0,1).value=res 
    Next v 

End Sub 

Answer 2

比方說，您的工作表看起來像這樣

那就試試這個

Option Explicit 

Sub Sample() 
    Dim ws As Worksheet 
    Dim lRow As Long, i As Long, n As Long 
    Dim MyAr, sval 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     For i = 1 To lRow 
      sval = .Range("A" & i).Value 
      If InStr(1, sval, " ") Then 
       MyAr = Split(sval, " ") 
       n = UBound(MyAr) + 1 
       Select Case n 
        Case 2: 
         .Range("B" & i).Value = Left(MyAr(0), 2) & Left(MyAr(1), 2) 
        Case 3 
         .Range("B" & i).Value = Left(MyAr(0), 2) & Left(MyAr(1), 1) & Left(MyAr(2), 1) 
        Case 4 
         .Range("B" & i).Value = Left(MyAr(0), 1) & Left(MyAr(1), 1) & _ 
               Left(MyAr(2), 1) & Left(MyAr(3), 1) 
       End Select 
      Else 
       .Range("B" & i).Value = Left(sval, 4) 
      End If 
     Next i 
    End With 
End Sub 

輸出