AW: Daten an Tabelle anhängen
01.07.2006 21:28:36
fcs
Hallo Christoph,
die folgenden Makros im VBA-Editor in ein Modul kopieren. ggf erst ein Modul einfügen
Sub Fragen_OK1_BeiKlick() ' OK nr.1
Call LoeschenFrage(Range("D5"))
End Sub
Sub Fragen_Nein1_BeiKlick() ' Nein Nr.1
Call EinfuegenFrage(Range("D5"))
End Sub
Sub Fragen_OK2_BeiKlick() ' OK nr.2
Call LoeschenFrage(Range("D6"))
End Sub
Sub Fragen_Nein2_BeiKlick() ' Nein Nr.2
Call EinfuegenFrage(Range("D6"))
End Sub
Sub Fragen_OK3_BeiKlick() ' OK nr.3
Call LoeschenFrage(Range("D7"))
End Sub
Sub Fragen_Nein3_BeiKlick() ' Nein Nr.3
Call EinfuegenFrage(Range("D7"))
End Sub
Sub Fragen_OK4_BeiKlick() ' OK nr.4
Call LoeschenFrage(Range("D8"))
End Sub
Sub Fragen_Nein4_BeiKlick() ' Nein Nr.4
Call EinfuegenFrage(Range("D8"))
End Sub
Sub Fragen_OK5_BeiKlick() ' OK nr.5
Call LoeschenFrage(Range("D9"))
End Sub
Sub Fragen_Nein5_BeiKlick() ' Nein Nr.5
Call EinfuegenFrage(Range("D9"))
End Sub
Sub Fragen_OK6_BeiKlick() ' OK nr.6
Call LoeschenFrage(Range("D10"))
End Sub
Sub Fragen_Nein6_BeiKlick() ' Nein Nr.6
Call EinfuegenFrage(Range("D10"))
End Sub
Private Sub EinfuegenFrage(Text As String)
Dim wksAbweichungen As Worksheet
Set wksAbweichungen = Sheets("Abweichungen")
With wksAbweichungen
If .Cells(.Rows.Count, "B").End(xlUp).Row = 2 Then
' noch keine Einträge vorhanden
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = Text
Else
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).EntireRow.Insert
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = Text
End If
End With
End Sub
Private Sub LoeschenFrage(Text As String)
Dim wksAbweichungen As Worksheet, Finden As Range
Set wksAbweichungen = Sheets("Abweichungen")
With wksAbweichungen
Set Finden = .Range(.Cells(3, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Find(What:=Text, LookIn:=xlValues, Lookat:=xlWhole)
If Finden Is Nothing Then
MsgBox ("Frage in Abwweichungen nicht gefunden!")
Else
Finden.EntireRow.Delete
End If
End With
End Sub
Anschließend den Option-Buttons die entsprechenden Makros Fragen_OK... bzw. Fragen_Nein... zuweisen
Voraussetzung für korrektes funktionieren ist natürlich, das die Fragetexte immer unterschiedlich sind.
Damit die Makros korrekt funktionieren muß du die unnötiger weise verbundenen Zellen in den Spalten D, E und F wieder in Einzelzellen auflösen. mache Spalte D entsprechend breiter und lösche die Spalten E und F.
mfg
Franz