Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1868to1872
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
1868to1872
1868to1872
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Loop/ Wiederholung

VBA Loop/ Wiederholung
07.02.2022 15:24:21
Manu
Hallo!
Mein derzeitiger VBA Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" And Target.Value = (" ") Then
Dim strDateiname As String
ChDrive "c:\"
strDateiname = Range("A2") & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
End If
Dim Bereich As Range
If Intersect(Target, _
Range("A16:A26,A32:A42,A66:A86,A116:A136,A166:A186,A216:A236,A266:A286,A316:A336,A366:A386,A416:A436,A466:A486,A516:A536,A566:A586,A616:636,A666:A686,A716:A736,A766:A786,A816:A836")) _
Is Nothing Then Exit Sub
Set Bereich = Intersect(Target.EntireRow, Range("A:H"))
If Target.Value  "" Then
Bereich.Borders(1).LineStyle = xlContinuous
Bereich.Borders(2).LineStyle = xlContinuous
Bereich.Borders(3).LineStyle = xlContinuous
Bereich.Borders(4).LineStyle = xlContinuous
Else
Bereich.Borders(1).LineStyle = xlNone
Bereich.Borders(2).LineStyle = xlNone
Bereich.Borders(3).LineStyle = xlNone
Bereich.Borders(4).LineStyle = xlNone
End If
End Sub
Wie man sieht ist die Range immer wieder eine Wiederholung nach A36:A42
ab A66:A86 immer plus 50
Leider habe ich nichts gefunden um dies auf unbegrenzt zu Wiederholen
Bitte um Hilfe

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Loop/ Wiederholung
07.02.2022 16:09:33
GerdL
Hallo Manu,
nur angetest:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strDateiname As String
If Target.Address = "$A$1" And Target.Cells(1).Value = (" ") Then
ChDrive "c:\"
strDateiname = Range("A2") & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
End If
If Target.Column = 1 Then
Select Case Target.Cells(1).Row
Case 16 To 26, 32 To 42
Case Else
Select Case Target.Cells(1).Row Mod 50
Case 16 To 36
Case Else
Exit Sub
End Select
End Select
With Intersect(Target.Cells(1).EntireRow, Range("A:H"))
If Target.Cells(1).Value  "" Then
.Borders(1).LineStyle = xlContinuous
.Borders(2).LineStyle = xlContinuous
.Borders(3).LineStyle = xlContinuous
.Borders(4).LineStyle = xlContinuous
Else
.Borders(1).LineStyle = xlNone
.Borders(2).LineStyle = xlNone
.Borders(3).LineStyle = xlNone
.Borders(4).LineStyle = xlNone
End If
End With
End If
End Sub
Gruß Gerd
Anzeige
AW: VBA Loop/ Wiederholung
07.02.2022 16:14:49
Rudi
Hallo,

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim b As Boolean, Bereich As Range
If Target.Address = "$A$1" And Target.Value = (" ") Then
Dim strDateiname As String
ChDrive "c:\"
strDateiname = Range("A2") & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
End If
Select Case Target.Row
Case 16 To 26, 36 To 42: b = True
Case Else
Select Case Target.Row Mod 50
Case 16 To 36: b = True
End Select
End Select
If b Then
Set Bereich = Intersect(Target.EntireRow, Range("A:H"))
If Target.Value  "" Then
Bereich.Borders(1).LineStyle = xlContinuous
Bereich.Borders(2).LineStyle = xlContinuous
Bereich.Borders(3).LineStyle = xlContinuous
Bereich.Borders(4).LineStyle = xlContinuous
Else
Bereich.Borders(1).LineStyle = xlNone
Bereich.Borders(2).LineStyle = xlNone
Bereich.Borders(3).LineStyle = xlNone
Bereich.Borders(4).LineStyle = xlNone
End If
End If
End Sub
Gruß
Rudi
Anzeige
AW: VBA Loop/ Wiederholung
08.02.2022 15:47:30
Manu
Hier mein derzeitige Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Speichern wenn externes Programm A1 mit Leertaste beschreibt
Dim b As Boolean, Bereich As Range
If Target.Address = "$A$1" And Target.Value = (" ") Then
Dim strDateiname As String
ChDrive "c:\"
strDateiname = Range("A2") & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
End If
' Bedingung für Automatisches auswählen
Select Case Target.Row
Case 16 To 26, 32 To 42: b = True               ' Zeile 16 bis 26 & 32 bis 42 ausgewählt
Case Else
End Select
Select Case Target.Row Mod 50
Case 16 To 36: b = True                         ' nach 50 Zeilen wiederholt auswählen (Wert1:16,66,116.... Wert2:36,86,136...)
End Select
Select Case Target.Row
Case 27 To 31: b = False                        ' bestimmte Zeilen nicht auswählen
End Select
' Rahmen setzen unter Bedingung von b und wenn Wert in b gesetzt wird
If b Then
Set Bereich = Intersect(Target.EntireRow, Range("A:H"))
If Target.Value  "" Then
Bereich.Borders(1).LineStyle = xlContinuous
Bereich.Borders(2).LineStyle = xlContinuous
Bereich.Borders(3).LineStyle = xlContinuous
Bereich.Borders(4).LineStyle = xlContinuous
Else
Bereich.Borders(1).LineStyle = xlNone
Bereich.Borders(2).LineStyle = xlNone
Bereich.Borders(3).LineStyle = xlNone
Bereich.Borders(4).LineStyle = xlNone
End If
End If
End Sub
Problem wäre damit erst mal gelöst.
Vielen Dank für die sehr hilfreiche Informationen :-)
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige