Text suchen, dann Zeile einfügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Text suchen, dann Zeile einfügen
von: Selma
Geschrieben am: 25.05.2015 20:28:06

Hallo Leute,
ich möchte folgendes via VBA erreichen. In der Spalte B soll nach dem Zellinhalt gesucht werden, der mit [SOURCE= beginnt. Falls dies Zellinhalt gefunden wird, dann drunter eine neue Zeile einfügen und diesen Text [MODEL=:Default:] eintragen. Die letzte Zelle mit dem Inhalt kann in Spalte A ermittelt werden.
Wie mache ich das bitte?
Schönen Gruß,
Selma

Bild

Betrifft: AW: Text suchen, dann Zeile einfügen
von: Daniel
Geschrieben am: 25.05.2015 20:34:51
Hi
wie gross ist deine Tabelle und wie oft kommt es vor, dass eine Zelle mit [Source beginnt?
Gruß Daniel

Bild

Betrifft: AW: Text suchen, dann Zeile einfügen
von: Selma
Geschrieben am: 25.05.2015 20:46:18
Hi Daniel,
ab der Zeile 6 ist das immer der Fall. Es sind ca. 800 Zeilen.
Gruß,
Selma

Bild

Betrifft: AW: Text suchen, dann Zeile einfügen
von: Sepp
Geschrieben am: 25.05.2015 20:56:01
Hallo Selma ;-))

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub insertLines()
  Dim rng As Range
  Dim lngCalc As Long
  Dim lnglast As Long, lngI As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = -4135
    .DisplayAlerts = False
  End With
  
  With ActiveSheet
    lnglast = Application.Max(6, .Cells(.Rows.Count, 1).End(xlUp).Row)
    For lngI = lnglast To 6 Step -1
      If .Cells(lngI, 2) Like "[[]SOURCE=*" Then
        .Rows(lngI + 1).EntireRow.Insert
        .Cells(lngI + 1, 2) = "[MODEL=:Default:]"
      End If
    Next
  End With
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'insertLines'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - insertLines"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
    .StatusBar = False
  End With
  
End Sub


Gruß Sepp

Bild

Betrifft: AW: Text suchen, dann Zeile einfügen
von: Daniel
Geschrieben am: 25.05.2015 21:06:46
Hi
probier mal das:

Sub Einfügen()
With ActiveSheet.UsedRange
    With .Columns(.Columns.Count).Offset(0, 1).Resize(, 2)
        .Columns(1).Formula = "=Row()"
        .Columns(2).FormulaR1C1 = "=IF(Left(RC2,8)=""[SOURCE="",Row(),"""")"
        .Formula = .Value
        .Columns(2).SpecialCells(xlCellTypeConstants, 1).Copy
        .Cells(.Rows.Count, 1).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Offset(0, 2 - Selection.Column).Value = "[MODEL=:Default:]"
        .CurrentRegion.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
        .EntireColumn.ClearContents
    End With
End With
End Sub
Gruß Daniel

Bild

Betrifft: AW: Text suchen, dann Zeile einfügen
von: Selma
Geschrieben am: 25.05.2015 21:22:02
Hallo Sepp ;-) es funktioniert...
Hallo Daniel, deine Lösung funktioniert auch.
Besten Dank....
Schöne Grüße,
Selma

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Text suchen, dann Zeile einfügen"