Matrix einfügen unter Berücksichtigung der Anzahl

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Matrix einfügen unter Berücksichtigung der Anzahl
von: artuk
Geschrieben am: 23.03.2005 11:33:35
Guten morgen alle zusammen,
habe ein kleine Frage.
Ich habe eine Datenmatrix, die ausgefüllt wird. Nachdem ausfüllen soll über ein Button die Matrix in die letzte freie Zeile wieder eingefügt werden, aber unter Berücksichtigung der Anzahl. D.h. es muss eine Massagebox kommt, in der ich die Anzahl der einzufügenden Zeile angeben kann.
Funktioniert das mit VBA?
https://www.herber.de/bbs/user/20051.xls
Vielen Dank für die Hilfe
MFG
artuk

Bild

Betrifft: AW: Matrix einfügen unter Berücksichtigung der Anzahl
von: UweD
Geschrieben am: 23.03.2005 12:04:24
Hallo
Dieses Makro kannst du der Schaltfläche zuweisen

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

Gruß UweD
Bild

Betrifft: AW: Matrix einfügen unter Berücksichtigung der Anzahl
von: artuk
Geschrieben am: 23.03.2005 13:12:29
Hallo Uwe,vielen Dank für die schnelle Hilfe, es funktioniert ganz gut.
Eins habe ich aber noch, wie kann ich die Gültigkeit, die in b1 und b2 steht mitnehmen und die Fragen1...4. Geht das?
Vielen Dank für die Hilfe
MFG
artuk
Bild

Betrifft: AW: Matrix einfügen unter Berücksichtigung der Anzahl
von: UweD
Geschrieben am: 23.03.2005 15:28:09
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
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Matrix einfügen unter Berücksichtigung der Anzahl"