从循环VBA复制单元格

我有一个填充string单元格的空格分隔的列，如：

"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不返回任何东西？

当我通过范围的单元格循环时，如何说我想将a，b，c和d的级联值复制到相邻的单元格中？

编辑用“”replace“@”。

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 

产量