Matrix einfügen unter Berücksichtigung der Anzahl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Neu() Dim Anz%, TB, I%, LR Set TB = Sheets("Tabelle1") LR = TB.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A LR = LR + 1 TB.Cells(LR, 1).Value = "Seminar": LR = LR + 1 TB.Cells(LR, 1).Value = "Trainer": LR = LR + 3 Anz = InputBox("Anzahl der Teilnehmer ?", "Neues Seminar") If Anz > 0 Then For I = 1 To Anz TB.Cells(LR, 1).Value = "TN" & I LR = LR + 1 Next LR = LR + 3 TB.Cells(LR, 1).Value = "Ges" End If End Sub

Hallo nochmal
Ich hab jetzt alles reingebaut was irgendwo stand.
Bei den Gültigkeiten hab ich mal alle Optionen dringelassen, die kannst du evtl. selbst ergänzen.

Option Explicit
Sub Neu()
    Dim Anz%, TB, I%, LR, FR%
    Set TB = Sheets("Tabelle1")
    FR = 4 'Anzahl Fragen (kannst du ggf anpassen / wird im Folgenden Code dann automatisch erweitert)
    LR = TB.Cells(Rows.Count, 1).End(xlUp).Row 'ermittelt letzte Zeile der Spalte A
    LR = LR + 1
    TB.Cells(LR, 1).Value = "Seminar"
    TB.Cells(LR, 2).Value = "..."
    'Gültigkeit1
    With TB.Cells(LR, 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Seminare"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    LR = LR + 1
    TB.Cells(LR, 1).Value = "Trainer"
    TB.Cells(LR, 2).Value = "..."
    'Gültigkeit2
    With TB.Cells(LR, 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Trainer"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    LR = LR + 2

    'Fragen
    For I = 1 To FR
        TB.Cells(LR, I + 1).Value = "Frage" & I
    Next
    LR = LR + 1
    'Abfrage Teilnehmer
    Anz = InputBox("Anzahl der Teilnehmer ?", "Neues Seminar")
    If Anz > 0 Then
        'Teilnehmer einfügen
        For I = 1 To Anz
            TB.Cells(LR, 1).Value = "TN" & I
            LR = LR + 1
        Next

        'Summen
        TB.Range(Cells(LR, 2), Cells(LR, FR + 1)).FormulaR1C1 = "=SUM(R[-" & Anz & "]C:R[-1]C)"
        LR = LR + 1

        'Anzahl..
        TB.Range(Cells(LR, 2), Cells(LR, FR + 1)).FormulaR1C1 = "=COUNT(R[-" & Anz + 1 & "]C:R[-2]C)/R[-1]C"
        LR = LR + 2
        TB.Cells(LR, 1).Value = "Ges"

        'Mittelwert
        TB.Cells(LR, 2).FormulaR1C1 = "=SUM(R[-2]C:R[-2]C[" & FR - 1 & "])/" & FR
    End If
End Sub

Gruß UweD
Hier die geänderte Datei
https://www.herber.de/bbs/user/20087.xls

Beliebteste Forumthreads (12 Monate)

Matrix einfügen unter Berücksichtigung der Anzahl

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Matrix einfügen unter Berücksichtigung der Anzahl

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread