Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1204to1208
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1204to1208
1204to1208
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Excel stürzt ab

Excel stürzt ab
kirsche
Hallo Leute,
ich hab da ein Problem.
In einer Datei lasse ich ein Makro laufen, das ist auch alles soweit in Ordnung und funktioniert.
Nun das Phänomen:
Das Makro läuft auf zwei Rechnern einwandfrei, alles wird so gemacht, wie es soll.
Auf einem weiteren Rechner funktioniert das Makro auch, allerdings nicht jeden Tag.
Ich habe den Rechner mehrmals neu gestartet, aber das Makro streikt. Auf den anderen Rechnern streikt es nicht. Das phänomenale ist, gestern hat das Makro auch auf dem 3. Rechner funktioniert. Es ist ja nicht so, dass es garnicht auf dem 3. Rechner läuft. Excel meldet dann, es hat ein Problem festgestellt und bringt die übliche Meldung, ob diese an Microsoft gesendet werden soll.
Die Software ist auf allen 3 Rechnern gleich und auch die Hardware.
Betriebssystem ist Windows XP mit SP 2
und Excel 2002 mit SP 3
Ich habe mir auch die CPU-Auslastung angesehen, da läuft alles normal, sofern das Makro aufgerufen wird.
Kann mir da vielleicht jemand von Euch einen Tip geben, wie das sein kann, das ein Makro nur an einigen Tagen im Jahr ;-) funktioniert?
Mit freundlichen Grüßen
Dörte

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Ohne Makro keine Chance! Unsere laufen immer! orT
10.03.2011 02:52:06
Luc:-?
;->
Gruß Luc :-?
(er meint Du solltest mal Dein Makro hier posten)
10.03.2011 08:02:45
MichaV
..obwohl ich nicht glaube dass es sinnvoll ist, denn wenn Excel nur auf einem Rechner abstürzt dann liegt das Problem wohl nicht im Makro- Code.
Ich lass dann mal offen, Gruss- Micha
OT: Hej Micha, lange nicht gelesen!
10.03.2011 14:18:05
Luc:-?
Inzwischen hast du ja norsk so drauf, dass du sogar VBA-Englisch durch das ersetzt → And durch og beim „kleinen Drachen“… ;-)
Na, Schnee schon weg oder eher griechische als deutsche (Wetter-)Verhältnisse?
Gruß Luc :-?
AW: OT: Hej Micha, lange nicht gelesen!
10.03.2011 16:01:48
MichaV
Hei Luc,
hehe, das mit dem og ist mir auch erst nach der Rückfrage von amintire aufgefallen. Bei uns ist noch gut Schnee, haben letztes WE ein 4-Raum-Iglu gebaut. Da haben 4 Kids drin gesessen und ein Kaffeekränzchen gemacht. Und nächstes Wochenende ist Kinderskitag mit 8.000 Kindern auf Skiern, und die dazugehörigen Eltern dazu... Manche können noch nicht mal laufen und werden von den Eltern auf ihren Mini-Skiern stehend durch die Gegend geschoben. Normenn er jo født med ski på beina :o)
Gruss- und noch offen- Micha
Anzeige
AW: OT: Hej Micha, lange nicht gelesen!
10.03.2011 19:16:33
kirsche
Sorry Leute, aber ich dachte, ich bekomme eine Antwort auf meine Frage.
Excel stürzt ab
10.03.2011 19:38:28
kirsche
Hallo Luc,
ich glaube nicht, dass das Posten des Makros etwas bringt, denn es funktioniert auf insgesamt 3 Rechnern und auf dem 4. eben nur manchmal.
Ich habe heute auch nochmal alle Verweise und Add Ins geprüft und angepasst.
Komischer Weise funktionierte heute die Datei auch auf dem 4. Rechner, wo es gestern die Probleme gab.
Die Probleme tauchen auf den anderen 3 Rechnern nicht auf.
So sieht das erste Makro aus:
Private Sub CommandButton1_Click() 'daten übertragen von tagesretoure
If TextBox11.Value = 1 Or _
TextBox11.Value = 11 Or _
TextBox11.Value = 12 Or _
TextBox11.Value = 13 Then
If IsNumeric(TextBox10) Then
ActiveSheet.Unprotect 'Blattschutz aus
Range("A2").Value = ""
Range("A3").Value = ""
Range("A4").Value = TextBox10.Value
Calculate
Call tages_Fax_Vordruck_erstellen
ActiveSheet.PageSetup.PrintArea = "A1:I" & Range("A65536").End(xlUp).Row
ActiveSheet.Unprotect
Range("A5").End(xlDown).Select
Exit Sub
End If
End If
MsgBox "Dieser Lieferant ist nicht für die tägliche Retoure vorgesehen!"
With TextBox10
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
und dann geht es so weiter:
Public Sub tages_Fax_Vordruck_erstellen()
Dim lLetzte   As Long      ' letzte belegte Zeile Fax-Vordruck gemäß Spalte A
Dim lZeile    As Long      ' For/Next Zeilen-Index Fax-Vordruck
Dim lIndex    As Long      ' For/Next Index zum Type-Array
Dim ArtTab()  As TabDaten  ' der Type-Array
Dim rZelle    As Range     ' der Range zum Suchen in den Stammdaten
Dim lLetzte_E As Long      ' die letzte Zeile in der Eingabe
Dim lZeile_E  As Long      ' die gefundene Zeile in der Eingabe
Dim lZeile_S  As Long      ' die gefundene Zeile in den Stammdaten
Dim sStckKto  As Single    ' der Inhalt aus Stück/Karton - zum Rechnen
Dim WkSh_E    As Worksheet ' das Tabellenblatt "Eingabe"
Dim WkSh_S    As Worksheet ' das Tabellenblatt "Stammdaten"
Dim WkSh_L    As Worksheet ' das Tabellenblatt "Lieferanten"
ActiveSheet.Unprotect 'Blattschutz aus
'   kein Bildschirm-Update während der Verarbeitung zulassen
Application.ScreenUpdating = False
Set WkSh_E = Worksheets("Eingabe")
Set WkSh_S = Worksheets("Stammdaten")
Set WkSh_L = Worksheets("Lieferantenstamm")
'   mit dem Tabellenblatt "Fax-Vordruck" arbeiten
With Worksheets("Fax-Vordruck")
'       die letzte belegte Zeile im Blatt "Fax-Vordruck" gemäß Spalte A
lLetzte = IIf(.Range("A65536")  "", 65536, .Range("A65536").End(xlUp).Row)
'       evtl. bereits vorhandene Summenzeilen löschen
For lZeile = lLetzte To 7 Step -1
If .Range("A" & lZeile).Value = "Retoure - Gesamtbeleg" Then
.Rows(lZeile & ":" & lLetzte).Delete Shift:=xlUp
Exit For
End If
Next lZeile
'       vorhandene Werte (Einzelauflistung) löschen
.Range("A7:J" & lLetzte).ClearContents
'       die letzte belegte Zeile im Blatt "Eingabe" gemäß Spalte A
lLetzte_E = IIf(WkSh_E.Range("A65536")  "", 65536, _
WkSh_E.Range("A65536").End(xlUp).Row)
'       die passenden Einzelauflistungen aus der Eingabe holen
lZeile = 7
For lZeile_E = 4 To lLetzte_E
If Menue.Label5.Caption  "" Then
If Trim(Menue.Label5.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole  _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag  _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label8.Caption  "" Then
If Trim(Menue.Label8.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole  _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag  _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label9.Caption  "" Then
If Trim(Menue.Label9.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole  _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag  _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label10.Caption  "" Then
If Trim(Menue.Label10.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole  _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag  _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label11.Caption  "" Then
If Trim(Menue.Label11.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole  _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag  _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
'       die letzte belegte Zeile im Blatt "Fax-Vordruck" gemäß Spalte A
lLetzte = IIf(.Range("A65536")  "", 65536, .Range("A65536").End(xlUp).Row)
'       sortieren der Artikel-Nummer, um sie später aufsteigend zu haben
Range("A7:J" & lLetzte).Sort _
Key1:=Range("A7"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
ReDim ArtTab(1 To lLetzte)      ' ArtTab auf maximale Größe bringen
ArtTab(1).sArtikel = .Range("A7").Value     ' 1. Artikel-Nummer speichern
ArtTab(1).sBezeich = .Range("B7").Value     ' 1. Bezeichnung speichern
ArtTab(1).dMenge = CDbl(.Range("C7").Value) ' 1. Menge speichern
For lZeile = 8 To lLetzte ' ab 8, weil Zeile 7 schon im Type-Array gespeichert ist
For lIndex = 1 To lLetzte
If ArtTab(lIndex).sArtikel = .Range("A" & lZeile).Value Then
ArtTab(lIndex).dMenge = ArtTab(lIndex).dMenge + _
CDbl(.Range("C" & lZeile).Value)
Exit For
ElseIf ArtTab(lIndex).sArtikel = "" Then ' 2. bis n-te Daten an Array
ArtTab(lIndex).sArtikel = .Range("A" & lZeile).Value
ArtTab(lIndex).sBezeich = Trim(.Range("B" & lZeile).Value)
ArtTab(lIndex).dMenge = CDbl(.Range("C" & lZeile).Value)
Exit For
End If
Next lIndex
Next lZeile
lZeile = lLetzte + 1  ' die letzte belegte Zeile + 1 ist Start-Zeile der Summen
'formatierungen
With .Range("A" & lZeile)
.Font.Size = 16
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.RowHeight = 20
End With
With .Range("I" & lZeile)
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
With .Range("A" & lZeile + 1)
.Font.Size = 8
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With .Range("E" & lZeile + 1 & ":F" & lZeile + 1)
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.RowHeight = 18
End With
.Range("A" & lZeile).Value = "Retoure - Gesamtbeleg"
'.Range("I" & lZeile).Value = ""
lZeile = lZeile + 1
.Range("A" & lZeile).Value = "FZ Art.Nr."
.Range("B" & lZeile).Value = "Artikelbezeichnung"
.Range("C" & lZeile).Value = "KT-Einheit"
'.Range("D" & lZeile).Value = "heit"
.Range("E" & lZeile).Value = "Gesamt-Menge"
.Range("F" & lZeile).Value = "Lief.Art.Nr."
'Rahmen ziehen
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":F" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":F" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
For lIndex = 1 To UBound(ArtTab)
If ArtTab(lIndex).sArtikel = "" Then Exit For
lZeile = lZeile + 1
.Range("A" & lZeile).Value = ArtTab(lIndex).sArtikel
.Range("B" & lZeile).Value = ArtTab(lIndex).sBezeich
Set rZelle = WkSh_S.Range("A:A").Find(ArtTab(lIndex).sArtikel, _
Lookat:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
lZeile_S = rZelle.Row
If Trim(WkSh_S.Range("J" & lZeile_S).Value)  "KG" Then 'geändert von K auf J
If Trim(WkSh_S.Range("F" & lZeile_S).Value) = 50 Then
If Trim(WkSh_S.Range("J" & lZeile_S).Value) = "ST" Or _
Trim(WkSh_S.Range("J" & lZeile_S).Value) = "GL" Then
.Range("C" & lZeile).Value = _
CSng(WkSh_S.Range("V" & lZeile_S).Value) & " " & _
Trim(WkSh_S.Range("J" & lZeile_S).Value) & "/" & _
Trim(WkSh_S.Range("K" & lZeile_S).Value) 'K bleibt
sStckKto = CSng(WkSh_S.Range("V" & lZeile_S).Value)
Else
sStckKto = 0
End If
End If
If Trim(WkSh_S.Range("J" & lZeile_S).Value)  "KG" Then 'geändert von K auf J
.Range("C" & lZeile).Value = _
Trim(WkSh_S.Range("C" & lZeile_S).Value)
sStckKto = 9999
Else
sStckKto = 0
End If
Else
sStckKto = 0
End If
'            .Range("D" & lZeile).Value = Trim(WkSh_S.Range("K" & lZeile_S).Value)
.Range("F" & lZeile).Value = Trim(WkSh_S.Range("Q" & lZeile_S).Value)
.Range("I" & lZeile).Value = "Gesamtsumme"
End If
If sStckKto = 0 Then
.Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge), "0.000"" KG""")
Else
.Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge), "0"" Stück""")
'            .Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge) / sStckKto, _
'               "0.000"" Karton""")
End If
'Rahmen ziehen
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeLeft).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeTop).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeBottom).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeBottom).Weight =  _
xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeRight).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("D" & lZeile & ":H" & lZeile).Borders(xlInsideVertical).LineStyle =  _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("D" & lZeile & ":H" & lZeile).Borders(xlInsideVertical).Weight =  _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
Next lIndex
End With
Rows.AutoFit
Range("A6").FormulaR1C1 = "x"
'    Bildschirm-Update während der Verarbeitung wieder zulassen
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  'Blattschutz ein
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Gruß Dörte
Anzeige
Na da hab' ich ja was gemacht, aber nun...
11.03.2011 10:00:52
Luc:-?
…lese ich ja, Dörte,
hat auch auf 4.PC fktt, nachdem du quasi „Staub gewischt“ hast… ;-)
Hoffe, dass es dabei bleibt, denn möglicherweise war es nur ein temporäres PC-Peripherie-Datei-Problem, lag also im/am Zusammenspiel dieser Komponenten. Deine Pgmm sehen, abgesehen von der teilweise etwas unglückl Darstellung im Forum, recht ordentl aus, so dass sich daraus tatsächl dieses Verhalten wohl eher nicht erklären lässt. Das Einzige, was angemerkt wdn kann, ist, dass du beim Setzen der Rahmenlinien wohl mit jeweils 2-4 Befehlen auskommen müsstest, da diese ja rundum gleich sind (also Borders ohne die speziellen Items, außer ggf xlInsideVertical). Auf das .Unprotect könnte wahrscheinl auch verzichtet wdn, wenn du beim .Protect nur das UserInterface sperrst, was mit dem 4. benannten Parameter UserInterfaceOnly:=True erreicht wird. Das Pgm darf dann Änderungen auch an der geschützten Datei vornehmen, der Nutzer nicht.
Gruß + schöWE (auch nach Norge), Luc :-?
Anzeige

Links zu Excel-Dialogen

CommandButton Label

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige