Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Text suchen, dann Zeile einfügen

Text suchen, dann Zeile einfügen
25.05.2015 20:28:06
Selma
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

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

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

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

AW: Text suchen, dann Zeile einfügen
25.05.2015 20:56:01
Sepp
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

Anzeige
AW: Text suchen, dann Zeile einfügen
25.05.2015 21:06:46
Daniel
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

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

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige