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

Forumthread: VBA Wert suchen, Wert einfügen

VBA Wert suchen, Wert einfügen
09.03.2009 08:27:39
andreas
Hallo zusammen,
wie muss ich den Code schreiben, suche nach Zeilen in denen die Zelle "B" nicht leer ist.
In der Zeile in der die Zelle "B" nicht leer ist soll dann in Zelle "P" der Wert "1" eingetragen werden.
Danke für die Hilfe
Andreas
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Wert suchen, Wert einfügen
09.03.2009 08:41:41
Renee
Hi Andreas,
Und wieso unbedingt ein Code und nicht einfach in P2 die Formel:
=WENN(ISTLEER(B2);"";1) und runterkopieren ?
GreetZ Renée
AW: falls doch Code...
09.03.2009 08:46:59
Chris
.. dann so:

Sub such()
Dim RSuche As Range, RfInde As Range, strErste As String
Set RfInde = Range("B:B")
Set RSuche = RfInde.Find(what:="*", Lookat:=xlWhole, LookIn:=xlValues)
If Not RSuche Is Nothing Then
strErste = RSuche.Address
Do
Range("P" & RSuche.Row) = 1
Set RSuche = RfInde.FindNext(RSuche)
Loop While Not RSuche Is Nothing And RSuche.Address  strErste
Else
End If
End Sub


Gruß
Chris

Anzeige
AW: falls doch Code...
09.03.2009 08:57:20
andreas
Hallo Chris,
vielen Dank, funktioniert einwandfrei
AW: VBA Wert suchen, Wert einfügen
09.03.2009 08:51:52
andreas
Hallo Renee,
den weg über Formeln beherrsche ich recht gut, habe bewusst den Code über VBA gesucht.
Danke
AW: VBA Wert suchen, Wert einfügen
09.03.2009 08:55:44
Tino
Hallo,
hier mal 2 Möglichkeiten.
1. Möglichkeit
Sub NichtLeer()
Dim RBereich As Range
Dim MyArea
Dim A As Long

Set RBereich = Range("B2", IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp), Cells(Rows.Count, 2)))
'ohne Überschrift 
If Not Intersect(RBereich, Rows(1)) Is Nothing Then Exit Sub

MyArea = RBereich

For A = 1 To Ubound(MyArea)
  If MyArea(A, B) <> "" Then MyArea(A, B) = "1"
Next A

RBereich.Offset(0, 14) = MyArea
End Sub


2. Möglichkeit

Sub NichtLeer()
Dim RBereich As Range

Set RBereich = Range("B2", IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp), Cells(Rows.Count, 2)))
If Not Intersect(RBereich, Rows(1)) Is Nothing Then Exit Sub
Set RBereich = RBereich.Offset(0, 14)

RBereich.FormulaR1C1 = "=IF(RC2<>"""",1,"""")"
RBereich.Value = RBereich.Value
End Sub


Gruß Tino

Anzeige
AW: VBA Wert suchen, Wert einfügen
09.03.2009 09:05:43
Tino
Hallo,
Korrektur der ersten, kommt davon wenn man Code nur kopiert. ;-)
Sub NichtLeer()
Dim RBereich As Range
Dim MyArea
Dim A As Long

Set RBereich = Range("B2", IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp), Cells(Rows.Count, 2)))
'ohne Überschrift 
If Not Intersect(RBereich, Rows(1)) Is Nothing Then Exit Sub

MyArea = RBereich

For A = 1 To Ubound(MyArea)
  If MyArea(A, 1) <> "" Then MyArea(A, 1) = "1"
Next A

RBereich.Offset(0, 14) = MyArea
End Sub


Gruß Tino

Anzeige
Einzeiler
09.03.2009 09:55:30
mpb
Hallo Andreas,
Problem ist zwar schon gelöst, aber hier für das Archiv noch ein Einzeiler, der das Ganze auch (ohne Schleife) erledigt, sofern in Spalte B nur Werte oder nur Formeln stehen. Wenn beides gemischt ist, braucht man auch beide Codezeilen:

Sub Eins_in_P()
Columns("B:B").SpecialCells(xlCellTypeConstants, 23).Offset(0, 14) = 1 'für Werte
Columns("B:B").SpecialCells(xlCellTypeFormulas, 23).Offset(0, 14) = 1 'für Formeln
End Sub


Gruß
Martin

Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige