Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1592to1596
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bereich zwischen dem Start-und Endwert markieren

Bereich zwischen dem Start-und Endwert markieren
23.11.2017 11:03:08
Christian
Hallo zusammen,
ich bräuchte Hilfe zu folgender Sachlage:
in der nachfolgend gezeigten Tabelle möchte ich gerne mit einem Makro in Spalte C, die Bereiche zwischen den Startwerten 1 in Spalte A und den Endwerten 1 in Spalte B mit 1ern auffüllen.
Zusätzlich soll das Makro abbrechen, wenn in Spalte A kein Wert mehr steht.
Meine Kenntnisse in VBA sind gering und ich muss gestehen, dass ich für diese Aufgabe noch nicht einmal einen Ansatz habe.
Ich wäre für jede Hilfe dankbar!
Beste Grüße
Userbild
Christian

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

Betreff
Datum
Anwender
Anzeige
Teste mal...
23.11.2017 11:24:02
Michael
folgenden Code, Christian,
...dem allerdings die Annahme/Bedingung zu Grunde liegt, dass die Start- und End-Zellen strikt paarweise auftreten, es also nicht mehr Start- als Ende-Zellen gibt oder vice versa.
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim r As Range, f As Range, ff$, a(), b(), i&
Application.ScreenUpdating = False
With Ws
Set r = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Set f = r.Find(what:="1", LookIn:=xlValues, lookat:=xlWhole)
ReDim a(1 To r.Cells.Count)
If f Is Nothing Then
MsgBox "Kein Starteintrag gefunden!", vbCritical, "Abbruch"
Exit Sub
Else:
ff = f.Address
Do
i = i + 1
a(i) = f.Address
Set f = r.FindNext(f)
Loop While Not f Is Nothing And f.Address  ff
ReDim Preserve a(1 To i): i = 0
Set f = Nothing: Set r = Nothing
End If
Set r = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
Set f = r.Find(what:="1", LookIn:=xlValues, lookat:=xlWhole)
ReDim b(1 To r.Cells.Count)
If f Is Nothing Then
MsgBox "Kein Endeintrag gefunden!", vbCritical, "Abbruch"
Exit Sub
Else:
ff = f.Address
Do
i = i + 1
b(i) = f.Address
Set f = r.FindNext(f)
Loop While Not f Is Nothing And f.Address  ff
ReDim Preserve b(1 To i): i = 0
Set f = Nothing: Set r = Nothing
End If
For i = LBound(a) To UBound(a)
Set r = .Range(.Range(a(i)), .Range(b(i)))
r.Offset(, 2).Resize(r.Rows.Count, 1).Value = 1
Next i
End With
Set Wb = Nothing: Set Ws = Nothing: Set r = Nothing
Erase a: Erase b
End Sub
LG
Michael
Anzeige
Formellösung
23.11.2017 11:26:49
ChrisL
Hi Christian
Hier eine Idee für eine Formellösung, Zelle C2 folgende:
=WENN(ODER(A2=1;UND(C1=1;B11));1;"")
cu
Chris
AW: Bereich zwischen dem Start-und Endwert markieren
23.11.2017 11:38:10
UweD
Noch eine Variante

Tabelle1
 ABC
1StartEnde Dauer
2101
3001
4001
5001
6001
7001
8001
9001
10011
1100 
1200 
1300 
1400 
15101
16001
17001
18001
19001
20001
21001
22001
23001
24001
25001
26001
27011
2800 
2900 
3000 

verwendete Formeln
Zelle Formel Bereich N/A
C2:C30=WENN(SUMME($A$2:A2)-SUMME($B$1:B1)>0;1;"")  
http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip
http://Hajo-Excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 21.10 einschl. 64 Bit


LG UweD
Anzeige
AW: Bereich zwischen dem Start-und Endwert markieren
23.11.2017 12:35:47
Christian
Vielen herzlich Dank!
Alle drei Varianten funktionieren einwandfrei!
Gruß Christian
also zu und geschlossen ... (owT)
23.11.2017 14:17:15
EtoPHG

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige