Zelle automatisch finden und befüllen

[minhtran]

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

[mrthiemann]

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.

[DbSam]

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

[DbSam]

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

[minhtran]

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

[DbSam]

Hallo Minh,

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

[schauan]

Hallo Minh,

vor allen Dingen wäre auch wichtig, was wir unter

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?
- ...

[snb]

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

[minhtran]

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

[schauan]

Hallöchen,

ein WorksheetChange-Makro kommt in das Codemodul des Tabellenblattes, wo es ausgeführt werden soll. Dbsam hatte das damit gemeint:

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.