VBA从循环中复制单元格

时间:2013-12-13 17:34:18

标签: excel vba excel-vba

我的列中填充了由空格分隔的字符串单元格,例如:

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

我的目标是:

  1. 当有四个单词时,我会记下每个单词的每个字母
  2. 当有三个单词时,我取第一个单词的前两个字母,然后是下面几个单词的每个单词
  3. 当有两个单词时,我会取每个单词的前两个字母
  4. 如果只有一个单词,我会使用前四个字母
  5. 对于每种情况,我将找到的四个字母复制到同一行的另一个单元格中。

    刚接触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的连接值复制到相邻的单元格中?

    编辑将“@”替换为“”。

2 个答案:

答案 0 :(得分:2)

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

答案 1 :(得分:2)

假设您的工作表看起来像这样

enter image description here

然后试试这个

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

<强>输出

enter image description here