2015-05-13 3 views
2

Я создал макрос, как показано ниже в Excel. В столбце значения A разделяются точкой с запятой. В столбце A имеются значения сплит-разрядов и замена разделенных значений в столбце B.VBA loop trough ячейки с ячейками со значением и заменить

Невозможно выполнить циклическое разделение значений.

Sub ReplaceAttachments3() 
Dim cl As Range 
Dim cell As Variant 
Dim i As Long 
Dim txt As String 
For Each cl In Range("$B$1:$B" & Range("$B65536").End(xlUp).Row) 
txt = Cells(cl.Row, 1) 
cell = split(txt, ";") 
    For i = 0 To UBound(cell) 
     Cells(cl.Row, 2).replace What:=txt, Replacement:="",LookAt:=xlPart, SearchOrder:= _ 
      xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
     Application.Goto Reference:="ReplaceAttachments" 
    Next i 
Next 
End Sub 

Что не так?

+0

Почему бы не просто использовать 'Text To Columns'? VBA не требуется. И если вы все еще хотите, чтобы VBA записывал макрос для «Text To Columns» –

+0

Я хотел бы заменить значения split в столбце B. Например, в столбце A: «a; b; c;» \t столбец B: «text text2 b text2 c», а в столбце B я хотел бы заменить значения как a, b, c на пустые значения. – user3114375

+0

, поэтому вы хотите удалить значения split из col B? –

ответ

1

Это то, что вы пытаетесь? Обратите внимание, что вам не нужно выбирать полный столбец. Просто найдите последний ряд и работайте только с этим диапазоном :)

Я прокомментировал код, поэтому у вас не должно возникнуть проблемы с его пониманием. Но если вы это сделаете, просто отправьте обратно.

Sub Sample() 
    Dim ws As Worksheet 
    Dim aCell As Range, rng As Range 
    Dim Lrow As Long, i As Long 
    Dim MyAr 

    '~~> Change this to the relevant worksheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     '~~> Find the last row in Col A 
     Lrow = .Range("A" & .Rows.Count).End(xlUp).Row 

     '~~> Set your range 
     Set rng = .Range("A1:A" & Lrow) 

     '~~> Loop trhough your range 
     For Each aCell In rng 
      '~~> Skip the row if value in cell A is blank 
      If Len(Trim(aCell.Value)) <> 0 Then 
       '~~> Check if the cell has ";" 
       '~~> If it has ";" then split and replace else 
       '~~> Replace without splitting 
       If InStr(1, aCell.Value, ";") Then 
        MyAr = Split(aCell.Value, ";") 

        For i = LBound(MyAr) To UBound(MyAr) 
         aCell.Offset(, 1).Value = Replace(aCell.Offset(, 1).Value, Trim(MyAr(i)), "") 
        Next i 
       Else 
        aCell.Offset(, 1).Value = Replace(aCell.Offset(, 1).Value, Trim(aCell.Value), "") 
       End If 
      End If 
     Next 
    End With 
End Sub 

Скриншот:

enter image description here

+0

Это работает как шарм :) Спасибо! – user3114375

Смежные вопросы