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"