Hallo ihr,
ich habe mein Problem mal schematisch bei Excel skizziert und hier einen Screenshot angehängt.
Ich würde gerne die weiße Fläche ausfüllen mit den Werten 0, 1 und 2.
Ich weiß nicht, ob das möglich ist, aber im Optimalfall sollte die Tabelle die gespiegelte Zelle im grau schraffierten Bereich finden und dort einen entgegengesetzten Wert eingeben. Also wenn ich in der weißen Fläche eine 0 eintippe, sollte in der gegenüberliegenden Zelle eine 2 erscheinen. Ich hab die Zellen, die beispielhaft "zusammengehören" sollen, farblich markiert. Ist das irgendwie möglich?
Ich hätte kein Problem das händisch zu machen, wenn die Tabelle nicht 200 Zeilen und 200 Spalten hätte. Noch dazu muss ich diese Tabelle 8 mal mit verschiedenen Werten erstellen. :16: :22:
Bin also dankbar über jede Hilfe!
Viele Grüße
Minh
Hy, was mir gerade so auf die schnelle einfällt, wäre der SVERWEIS.
Aber bei meinem Muster müsste das vorerst per Hand eingegeben werden. Bei der Menge an Daten vielleicht nicht die schönste Variante.
Hallo Minh,
bitte probiere mal folgenden Code hinter Deiner Tabelle:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Er
Dim iRow As Long, iCol As Long
If Intersect(Range("B2:GS201"), Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For iRow = Target.Row To Target.Row + Target.Rows.Count - 1
For iCol = Target.Column To Target.Column + Target.Columns.Count - 1
FillMySpecialCells iRow, iCol
Next iCol
Next iRow
Ex:
Application.EnableEvents = True
Exit Sub
Er:
MsgBox Err.Description, vbCritical, "Sub: Worksheet_Change in Tabelle1"
Resume Ex
'For debug:
Resume
End Sub
Private Sub FillMySpecialCells(ByVal iRow As Long, ByVal iCol As Long)
With ActiveSheet
Select Case .Cells(iRow, iCol)
Case vbNullString
.Cells(iCol, iRow) = vbNullString
Case 0
.Cells(iCol, iRow) = 2
Case 1
If Not iRow = iCol Then .Cells(iCol, iRow) = 1
Case 2
.Cells(iCol, iRow) = 0
Case Else
.Cells(iRow, iCol) = vbNullString
End Select
End With
End Sub
Gruß Carsten
Mir ist noch eine Ungereimtheit aufgefallen ...
Die Sub 'FillMySpecialCells' sollte besser so aussehen:
Code:
Private Sub FillMySpecialCells(ByVal iRow As Long, ByVal iCol As Long)
With ActiveSheet
If iRow = iCol Then
.Cells(iRow, iCol) = 1
Else
Select Case .Cells(iRow, iCol)
Case vbNullString
.Cells(iCol, iRow) = vbNullString
Case 0
.Cells(iCol, iRow) = 2
Case 1
.Cells(iCol, iRow) = 1
Case 2
.Cells(iCol, iRow) = 0
Case Else
.Cells(iRow, iCol) = vbNullString
End Select
End If
End With
End Sub
Gruß Carsten
Hallo Carsten,
hallo Karsten,
vielen Dank für eure Mühen!
Entschuldigung, dass ich mich erst jetzt wieder melde. Ich bin noch Student und war in den letzten Wochen total im Prüfungsstress. Werde mich jetzt aber wieder komplett dem Projekt widmen.
Der SVERWEIS macht eigentlich genaua das, was ich brauch. Nur ist das bei der Menge, wie du schon gesagt hast, sehr mühsam.
Den Code habe ich hinter meine Tabelle gepackt. Leider hat es nicht funktioniert. Ich weiß nicht, ob ich eventuell was falsch gemacht habe.
Vielen Dank nochmal
Minh
Hallo Minh,
(18.05.2017, 16:53)minhtran schrieb: [ -> ]Ich weiß nicht, ob ich eventuell was falsch gemacht habe.
... vermutlich.
Vielleicht hängst Du Deine Tabelle mal an.
Da kann man auch besser helfen, als bei einem Screenshot
Gruß Carsten
Hallo Minh,
vor allen Dingen wäre auch wichtig, was wir unter
Zitat:Leider hat es nicht funktioniert.
zu verstehen haben.
- sind codezeilen rot markiert? (siehe hier:
http://www.clever-excel-forum.de/misc.php?action=help&hid=9 )
- hast Du den Code im Tabellenblattmodul?
- kommen Fehlermeldungen?
- ...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Cells(1).Resize(200, 200)) Is Nothing Then Cells(Target.Column, Target.Row) = Choose(Target + 1, 2, 1, 0)
End Sub
Hallo zusammen,
beim Code ist nichts rot markiert und es kommen auch keine Fehlermeldungen.
Der Code ist im Modul1. Ich habe meine Tabelle1 ausgewählt und dann mit Alt+E und M dieses Modul erstellt. War das richtig oder sollte ich den Code direkt in Tabelle1 einfügen?
Ich konnte es auch ohne Fehlermeldung abspeichern, aber die Funktion war nicht da. Ich habe die Datei auch schon geschlossen und nochmal neu geöffnet.
Des Weiteren kann ich bei Ansicht -> Makros -> Makros anzeigen nichts auswählen.
Wenn ich snbs Code unten hinzufüge, kommt folgende Fehlermeldung.
Fehler beim Kompilieren: Mehrdeutiger Name: Worksheet_Change.
Sollte ich den Code irgendwo dazuwischen einfügen? Oder ganz am Schluss?
Kann es damit zuammenhängen, dass die Tabelle momentan nur eine Größe von 177x177 hat?
Ich habe die Tabelle angehängt!
Vielen Dank und Gruß
Minh
Hallöchen,
ein WorksheetChange-Makro kommt in das Codemodul des Tabellenblattes, wo es ausgeführt werden soll. Dbsam hatte das damit gemeint:
Zitat:bitte probiere mal folgenden Code hinter Deiner Tabelle:
Worksheet_Change darf es in einem Tabellenblattmodul auch nur 1x geben. Das gehört zu den sogenannten Ereignismakros, und von jedem darf da nur eins drin sein. Du müsstest dann mal den einen testen, den dann löschen und den anderen testen.
In das codemodul des Tabellenblattes kommst Du, indem Du im VBA-Editor links im Projektexplorer auf den Blatteintrag klickst bzw. doppelklickst. Schaue aber auch oben in der Titelleiste nach, ob Excel auch wirklich dorthin gewechselt hat.