Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1676to1680
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
Inhaltsverzeichnis

ActiveCell.FormulaR1C1 Schleife

ActiveCell.FormulaR1C1 Schleife
26.02.2019 10:52:10
Giorgi
Ich sitze an einem Plan und beschäftige mich mit folgenden Problem.
Ich will das man in eine Exceltabelle eine bestimmten Klassennamen einfügt in diesem Fall eine aus dem Case und die jeweiligen vier Spalten werden bunt eingefärbt. Dies habe ich soweit erfolgreich gelöst. Weitere Casefälle habe ich aus Einfachheit weg gelassen.
Das Problem:
Die Klassen habe aber einen längeren Titel die in einem weiteren Worksheet ("Übersetzung") niedergeschrieben sind.
D.h. ich schreibe in Spalte E 4 "Klasse-1a" die Zellen E4,F4,G4 und H4 werden eingefärbt.
Jetzt soll in der Zelle F4 der lange Titel der Klasse stehen.Dieser steht im Sheet "Übersetzung". Manuell würde ich in Zelle F4 "=Titel" schreiben und der Titel der jeweiligen Klasse wird mir angezeigt. Soweit funktioniert alles einwandfrei. Dennoch erstreckt sich die Datei auf viele Spalten.
Ich hab da an ein Vlookup per VBA gedacht leider komme ich nicht auf die Rangeeigenschaft.
Mein Anliegen wäre somit, einen Code zu generieren der prüft ob in der Spalte E und somit in jede weitere vierten Spalte I,M etc.etwas aus dem CaseFall steht,falls ja dann soll in der Folgespalte F,J etc. die Übersetzung der Klasse stehen.
Mit dem Makro Recorder komme ich leider nicht weiter der spuckt mir nur
ActiveCell.FormulaR1C1 = "=Titel"
Ich würde so anfangen
 For Spalte = 6 To 234 Step 4
Dann der gesuchte Code
Next Spalte

Hier ist der Code des Einfärbens
Public Sub Farbwechsel()
Dim itm As Range
Application.ScreenUpdating = False
Sheets("Plan").UsedRange.Offset(1).Interior.ColorIndex = xlColorIndexNone
For Each itm In Sheets("Plan").UsedRange.Offset(1)
If Not IsError(itm) Then
With itm
Select Case .Value2
'Klassen
Case "Klasse-1a", "Klasse-1b", "Klasse-1c", "Klasse-1d", "Klasse-1e", "Klasse-1f", _
"Klasse-1g"
.Interior.Color = RGB(218, 150, 148)
itm.Offset(0, 1).Interior.Color = RGB(218, 150, 148)
itm.Offset(0, 2).Interior.Color = RGB(218, 150, 148)
itm.Offset(0, 3).Interior.Color = RGB(218, 150, 148)
End Select
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Für Anregungen und Denkanstöße wäre ich sehr dankbar.
Gruß Giorgi

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

Betreff
Datum
Anwender
Anzeige
AW: ActiveCell.FormulaR1C1 Schleife
28.02.2019 09:58:54
Giorgi
Hallo ans Forum,
ich habe eine vereinfachte Datei hochgeladen.
Ich glaube ich habe mich leider zu unverständlich ausgedrückt.
Ich habe mich nochmal etwas im Forum eingelesen aber leider nix gefunden was Dynamische Range angeht.
Ich möchte mit der Zellüberwachung folgendes bezwecken.
Sobald ich die Klasse eingebe soll per SVERWEIS die Übersetzung angezeigt werden.Die Klassen stehen immer in den selben Spalten bzw. in jeder vierten Spalte aber in unterschiedlichen Zellen.
Einen normalen Vlookup bekomme ich hin aber wie kriege ich die dynamische Rangeeigenschaft mit rein?
https://www.herber.de/bbs/user/127988.xlsx
Gruß G.
Anzeige
Worksheet Change
28.02.2019 10:22:53
EtoPHG
Hallo Giorgi,
Ich kann mir einfach nicht erklären warum viele der Anfrager in diesem Forum von Schleifen reden. Offensichtlich ist dieser Begriff das Erste was denen unter VBA einfällt, obwohl sie keine Ahnung davon haben, ob denn das wirklich vonnöten ist.
Also diesen Code in das Tabellenblatt "Plan":
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column Mod 4  1 Then Exit Sub
If Left(Target, 6)  "Klasse" Then Exit Sub
Application.EnableEvents = False
With Worksheets("Übersetzung")
Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(0, 0) & _
"," & .Name & "!" & _
.Range(.Cells(.Rows.Count, 2).End(xlUp), .Cells(2, 1)).Address & _
",2,FALSE)"
End With
Application.EnableEvents = True
End Sub
Gruess Hansueli
Anzeige
AW: Worksheet Change
01.03.2019 09:17:06
Giorgi
Hallo Hansueli,
ich danke dir vielmals für den Code. Dieser funktioniert prima.
Falls sich die Klassenkürzel ändern in Form von "Modul1" oder "TES1K" oder andere beliebige Kürzel die im Sheet "Übersetzung" stehen , kann ich dann einfach den Code ergänzen?
If Left(Target, 6)  "Klasse" Then Exit Sub
zu

If Left(Target, 5) "Tes1K" Then Exit Sub

AW: Worksheet Change multiple Prefix
01.03.2019 11:17:51
EtoPHG
Hallo Giorgi,
Dann würde ich das eher so machen:
Private Sub Worksheet_Change(ByVal Target As Range)
Const Prefixes As String = "Klasse;Modul;TES1K"
Dim ix As Integer, tmp, doFormula As Boolean
If Target.Column Mod 4  1 Then Exit Sub
tmp = Split(Prefixes, ";")
For ix = 0 To UBound(tmp)
If Left(Target, Len(tmp(ix))) = tmp(ix) Then doFormula = True
Next ix
If Not doFormula Then Exit Sub
Application.EnableEvents = False
With Worksheets("Übersetzung")
Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(0, 0) & _
"," & .Name & "!" & _
.Range(.Cells(.Rows.Count, 2).End(xlUp), .Cells(2, 1)).Address & _
",2,FALSE)"
End With
Application.EnableEvents = True
End Sub

Damit muss du nur die Codezeile mit CONST so ergänzen, dass alle möglichen Prefixes enthalten sind.
Gruess Hansueli
Anzeige
AW: Worksheet Change multiple Prefix
04.03.2019 09:23:18
Giorgi
Vielen lieben Dank Hansueli

14 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige