Hat da keiner Ahnung?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Moin!
Schönen Dank erstmal, dass Du mein Gejammer erhört hast. Habe leider grad kein schickes Tool für den Code, deshalb kopier ich den einfach hier rein. Die Stelle an ders hängt markier ich fett und kursiv. Was ich halt nicht kapiere ist, warum schafft er das über 2000x mit teilweise identischen Werten, und dann auf einmal nicht mehr?
Also, schau hier (aber nicht lachen...):


Sub Soziogramme_Einfuegen()
' Warnungen abschalten
Application.DisplayAlerts = False
' Variablen deklarieren
Dim zeilen, spalten, anfangzahl, endezahl, ganummer, gwnummer, letzteanfangzahl, asciispalte, _
spaltenschleifenanfang, zeilenschleifenanfang, zeilenschleifenanfangi, spaltenschleifenanfangi As Long
Dim bereich, bildnummer, anfang, ende, spalte As String
Dim ga, gw As Double
' Tabellenmaße abfragen
zeilen = ActiveSheet.UsedRange.Rows.Count
spalten = ActiveSheet.UsedRange.Columns.Count
' Startpunkt abfragen
spaltenschleifenanfang = 51
zeilenschleifenanfang = 2
' Anfangspunk festlegen
anfangzahl = zeilenschleifenanfang
asciispalte = spaltenschleifenanfang + 64
' Endpunkt festlegen
letzteanfangzahl = zeilen - 1
' Schleifen-Anfänge festlegen
zeilenschleifenanfangi = zeilenschleifenanfang
spaltenschleifenanfangi = spaltenschleifenanfang
' Spalten-Schleife Beginn
For h = spaltenschleifenanfangi To spalten
' Spalte festlegen
If asciispalte <= 90 Then
spalte = Chr(asciispalte)
Else
spalte = Chr(Int((asciispalte - 64) / 26) + 64) + Chr((asciispalte - (Int((asciispalte - 64) / 26) * 26)))
End If
' Zeilen-Schleife Beginn
For i = zeilenschleifenanfangi To letzteanfangzahl Step 2
' Range festlegen
endezahl = anfangzahl + 1
anfang = spalte + Format(anfangzahl)
ende = spalte + Format(endezahl)
bereich = anfang + ":" + ende

' GA- und GW-Werte abfragen
ga = Range(anfang).Value
gw = Range(ende).Value


' Bildnummer festlegen
If ga = 0 Then
ganummer = 0
ElseIf ga > 0 And ga <= 6.25 Then
ganummer = 1
ElseIf ga > 6.25 And ga <= 12.5 Then
ganummer = 2
ElseIf ga > 12.5 And ga <= 25 Then
ganummer = 3
ElseIf ga > 25 And ga <= 50 Then
ganummer = 4
ElseIf ga > 50 And ga <= 100 Then
ganummer = 5
End If
If gw = 0 Then
gwnummer = 0
ElseIf gw > 0 And gw <= 6.25 Then
gwnummer = 1
ElseIf gw > 6.25 And gw <= 12.5 Then
gwnummer = 2
ElseIf gw > 12.5 And gw <= 25 Then
gwnummer = 3
ElseIf gw > 25 And gw <= 50 Then
gwnummer = 4
ElseIf gw > 50 And gw <= 100 Then
gwnummer = 5
End If
If ganummer = 0 Or gwnummer = 0 Then
bildnummer = "0"
Else
bildnummer = Format(gwnummer) + Format(ganummer)
End If
' Soziogramm einfügen!
Range(bereich).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Selection.ClearContents
ActiveSheet.Pictures.Insert("D:\Diplom\Preisinger\Preisinger_" + bildnummer + ".bmp").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 27.75
Selection.ShapeRange.Width = 27.75
Selection.ShapeRange.IncrementLeft 3
Selection.ShapeRange.IncrementTop 1.5
Selection.ShapeRange.PictureFormat.IncrementContrast 0.51
Selection.ShapeRange.PictureFormat.IncrementBrightness -0.48
' Einfügen zuende!
' Anfangzahl um 2 erhöhen
anfangzahl = anfangzahl + 2
' Zeilen-Schleife Ende
Next i
' Spaltenzahl um 1 erhöhen
asciispalte = asciispalte + 1
' Anfangszahl zurücksetzen
anfangzahl = zeilenschleifenanfang
' Spalten-Schleife Ende
Next h
' Warnungen wieder anschalten
Application.DisplayAlerts = True
End Sub

Gruß Emu

Boah, ick möcht Dir knutschen, Sepp!
Nein, ich versuch mich zu beherrschen. Funktioniert super, vielen herzlichen Dank! Musste nurnoch das Makro dazu bringen, nicht zweimal den erste Wert auszulesen (mit '(lRow + 1)' beim Zweiten statt nur 'lRow'). Krasser Code, und dabei war ich schon so stolz auf meinen (schäm...). Und die Performance, unglaublich, verglichen mit meiner Version. Die Sache mit den Spalten muss ich mir noch mal genauer anschauen. Hätte ich das blos gewusst, habe ewig gebraucht um die blöden 'Anwender-Spalten-Bezeichnungen' (aller AA, AB, AC usw.) hinzubekommen.
Hätte nie gedacht, dass das noch mal funktioniert. Nochmal ein dickes Lob für Dich, die Netz-Foren-Kultur lebt von Leuten wie Dir (ich meine die wirklich fitten Leute, die sich nicht zu schade sind, sich mit den Problemen blutiger Anfänger abzuplagen...).
Schöne Grüße und gute Nacht (jetzt kann ich wieder ruhig schlafen, hoffe ich...),
Emu

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread