Excel Tabelle mit VBA erstellen und füllen
Hallo Zusammen, ich habe eine knifflige Aufgabe zu lösen und bin leider nicht der fitteste in VBA-Makros:
Meine Aufgabenstellung lautet wie folgt.
ich habe eine Zelle in die ein Zahlenwert eingetragen wird. anschließend soll nach Betätigung eines Buttons eine Tabelle mit 2 Spalten und der Zeilenanzahl des Zahlenwertes erzeugt werden. In Spalte 1 soll eine fortlaufende Nummer Zeile für Zeile eingetragen weden bis der Wert aus A1 erreicht ist.
Spalte 2 muss dann wieder mit manuellen Werten gefüllt werden.
Jetzt soll ein weiterer Button eine andere Tabelle erzeugen. die mehrere Spalten hat 6 Spalten hat.
in Spalte1 soll solange der Wert aus Spalte1 der ersten Tabelle stehen bis der Wert aus der ersten Tabelle aus Spalte 2 erreicht ist dann weiter mit nächstem Wert...
z.B.
Zelle A1 steht 4
Button1
C D 1 1 2 2 3 3 4 4
manuelle eingabe in Spalte D C D 1 1 3 2 2 5 3 3 4 4 4 5
Button 2
F G 1 1 1 2 1 2 3 1 3 4 2 1 5 2 2 6 2 3 7 2 4 8 2 5 9 3 1 10 3 2 11 3 3 12 3 4 13 4 1 14 4 2 15 4 3 16 4 4 17 4 5 usw.
kann mir hier jemand vielleicht helfen?
7 Antworten
Also bitte, wir haben hier (als alte Hasen) so unsere Erfahrungen:
Unsere Programmierkenntnisse werden halt oft für Hausaufgaben missbraucht oder gar von Gewerblichen angefordert (neulich jemand von einem Medic-Center, die ja bestimmt genug Geld für einen bezahlten Programmierer hätten).
Da wird man eben vorsichtig
Auch wenn "Dächer berechnen" ja wohl kaum was ist, was Private machen, gehe ich eben mal von einem kleinen Unternehmer oder einer Einzelperson aus und schicke Dir hier nun die beiden Codes für die Button:
Private Sub CommandButton1_Click()
Dim Anzahl As Long
Dim I As Long
Anzahl = Cells(2, 1)
For I = 1 To Anzahl
Cells(7 + I, 1) = I
Next I
End Sub
Private Sub CommandButton2_Click()
Dim LastCell As Long
Dim LastRow As Long
Dim I As Long
Dim FirstGenerate As Double
Dim FirstContent As Double
Dim J As Long
Dim StartCell As Long
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
StartCell = 2
For I = 8 To LastRow
FirstGenerate = Cells(I, 1)
FirstContent = Cells(I, 2)
If FirstGenerate > 0 Then
For J = StartCell To FirstContent + StartCell - 1
Sheets("Tabelle2").Cells(J, 1) = FirstGenerate
Sheets("Tabelle2").Cells(J, 2) = J - StartCell + 1
Next J
StartCell = StartCell + FirstContent
End If
Next I
End Sub
Und noch was: wir sind nicht dazu da, den Programmierern die Arbeit weg zu nehmen. Die wollen auch ihr Geld verdienen..
Ersten klingt das derart kompliziert, dass ich mir nicht erklären kann, was, wo steht.
Zweiten sieht das nach einer Hausaufgabe in IT aus und die musst Du halt selber machen. Schummeln gilt nicht.
Es klingt nicht kompliziert aber lade doch bitte eine Besipieldatei da ich es mir gerade überhaupt nicht vorstellen kann.
Was meinst du mit Tabelle mit 6 Spalten? Als Tabelle formatiert oder dieses neue Tabellenfunktion oder ein neues Tabellenblatt(dieses hat per Definition 65536 Spalten)
Habe die Lösung selber gefunden ohne dummen Kommentare und Vermutungen von irgenwelchen Pseudo-IT-Fuzzis, nochmal Kompliment an den hervorragenden Support.
Ist zwar nur eine Lösung mit Formeln aber es funktioniert: Jetzt kann ich zum eigentlichen Teil der Problemstellung gehen, aber damit kann man hier ja keinen belasten, weil ja jeder seine "Hausaufgaben" selber machen muss...
für die, die es interesseiert:
s. Screenshot und Formeln...
SpalteB --> WENN(B2="";"";WENN(B2=$A$2;"";B2+1))
SpalteD --> WENN(D2="";"";WENN(D2+WENN(ZEILE()-1<=SUMME($C$2:INDEX(C$2:C$1048576;D2));0;1)>$A$2;"";D2+WENN(ZEILE()-1<=SUMME($C$2:INDEX(C$2:C$1048576;D2));0;1)))
SpalteE --> WENN(D3="";"";WENN(D3=D2;E2+1;1))

Hier ein Screenshot zur Problemstellung.

es ist alles auf Basis des obigen Screenshots erstellt
Sub ErsteTab()
For i = 1 To Range("A2").Value
Cells(i + 7, 1) = i
Next i
End Sub
Sub ZweiteTab()
Range("E9:F1000").ClearContents
For j = 8 To 7 + Range("A2").Value
For i = 1 To Cells(j, 2)
Range("F" & [F1000000].End(xlUp).Row + 1) = i
Range("E" & [E1000000].End(xlUp).Row + 1) = Cells(j, 1).Value
Next i
Next j
End Sub