Mit Makro Zeilen an bestimmter Stelle einfügen!

Question

Hallo, ich bin auf der Suche nach einem Makro, welches mir eine Abfrage ausführt und dann an dieser bestimmten stelle eine Leerzeile einfügt.
suche Zeile in Spalte B mit dem Wert "2.01" und füge oberhalb dieser Zeile eine Leerzeile ein!

Vielen Dank im Voraus!

Answer 1

Hallo Mr.Smooth
vielleicht hilft dir das Makro.

Gruß
fedjo

Option Explicit
Sub Suchen()
Dim strSuch As String, lngAnz As Long
strSuch = "2.01"
lngAnz = WorksheetFunction.CountIf(Columns(2), strSuch)
Columns(2).Find(what:=strSuch, LookIn:=xlValues, MatchCase:=False).EntireRow.Insert
End Sub

Answer 2

Hallo Fedjo,

erstmal vielen Dank für Deine schnelle Antwort.

Wenn ich Deine Lösung Ausführe wird nur in der ersten Zeile eine Leerzeile eingefügt. Was muss ich einfügen, um das gesamte Arbeitsblatt (1421 Zeilen) zubearbeiten?

Viele Grüße

Mr. Smooth

Answer 3

hi all

wie gewuenscht

gruss nighty

Sub einfuegen()
Dim zaehler As Long
ReDim BereichA(Cells(Rows.Count, 1).End(xlUp).Row, 1) As Variant
BereichA() = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For zaehler = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If BereichA(zaehler, 1) = "2.01" Then
Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
End If
Next zaehler
End Sub

Answer 4

hi all :-)

ups

hier fuer spalte b ^^

gruss nighty

Sub einfuegen()
Dim zaehler As Long
ReDim BereichA(Cells(Rows.Count, 2).End(xlUp).Row, 1) As Variant
BereichA() = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
For zaehler = 1 To Cells(Rows.Count, 2).End(xlUp).Row
If BereichA(zaehler, 1) = "2.01" Then
Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
End If
Next zaehler
End Sub

Answer 5

Hi, dir auch vielen Dank für die schnelle Antwort.

Das Ergebnis der Ausführung ist nicht eindeutig. Mal fügt es unter der Zeile 2.01 eine Leerzeile ein, mal oberhalb der Zeile 2.01 und an anderer Stelle sehr willkürlich.


Die Tabelle sieht wie folgt aus:
Spalte A = 1
Spalte B = 0001
Spalte C = Kaliumdichromat 0,5% vas
Spalte D = 1
Spalte E = 2.01

1 0001 Kaliumdichromat 0,5% vas 1 2.01
................................................................................2 2.02
benötigte Leerzeile
2 0001/1 Kaliumdichromat 0,25% vas 1 2.01
................................................................................2 2.02
benötigte Leerzeile
3 0003 Thiuram Mix [A] 1% vas 1 2.01
.................................................................................2 2.02
.................................................................................3 2.03
.................................................................................4 2.04
.................................................................................5 2.05
benötigte Leerzeile
4 0003/1 Thiuram Mix [B] 1,25% vas 1 2.01
.................................................................................2 2.02
.................................................................................3 2.03
.................................................................................4 2.04
.................................................................................5 2.05
.................................................................................6 2.06
benötigte Leerzeile
5 0004 Neomycinsulfat 20% vas 1 2.01
..................................................................................2 2.02

Jeweils oberhalb der Zeile "2.01" benötige ich eine Leerzeile!

Vielen Dank Ihr seid mir eine große Hilfe!

Mr.Smooth

Answer 6

hi all :-)

ups

gruss nighty

Sub einfuegen()
Dim zaehler As Long
ReDim BereichA(Cells(Rows.Count, 2).End(xlUp).Row, 1) As Variant
BereichA() = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
For zaehler = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If BereichA(zaehler, 1) = "2.01" Then
Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
zaehler = zaehler - 1
End If
Next zaehler
End Sub

Answer 7

Tausend Dank nighty, du hast mir ne Menge Arbeit erspart. Die Lösung funktioniert hervorragend.

Viele Grüße

Mr. Smooth

Answer 8

hi all :-)

fedjo seine loesung ist aber auch gut ,nur bisl langsamer :-)

daher ist dieses beispiel fuer fedjo,eine dynamische schleife

gruss nighty

Option Explicit
Sub Suchen()
Dim suche As Range
Dim zaehler As Long
zaehler = 1
Do
Set suche = Workbooks(1).Worksheets(1).Range("A" & zaehler & ":A" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find("2.01")
If Not suche Is Nothing Then
Rem etwas gefunden
zaehler = suche.Row + 1
Else
Rem nicht gefunden
Exit Do
End If
Loop
End Sub

Answer 9

hi all :-)

treffer waere dann

cells(suche.row,suche.column)

gruss nighty